CreateObject - Outlook

Er det en undermappe du skal have oprettet, eller er det en mappe du allerede har oprettet?

Jeg har givet dig et kode eksempel på hvordan du opretter en ny undermappe og heri opretter en ny contact. Du skal lige huske at før dette virker, så skal der sættes en reference til Microsoft Outlook 10.0 Object Library

Det kan være det står andet end 10.0, men så skal du bare vælde den version der er der. Det virker til at alle versioner af Outlook.

    Dim oOutlook As Outlook.Application
    Dim ns As NameSpace
    Dim fld As MAPIFolder
    Dim contact As ContactItem
    Set oOutlook = New Outlook.Application
    Set ns = oOutlook.GetNamespace("MAPI")
    Set fld = ns.GetDefaultFolder(olFolderContacts)
   
    Set fld = fld.Folders.Add("test")
    Set contact = fld.Items.Add
   
    contact.CompanyName = "Target Gruppen ApS"
   
    contact.Save
   
    Set contact = Nothing
    Set ns = Nothing
    Set oOutlook = Nothing

Spørg hvis du er i tvivl :-)

VH CK

Jeg har ikke lige mulighed for at afprøve det lige nu, men vender tilbage senere. Faktisk så er mappen allerede oprettet, jeg vil bare specificere at kontaktpersonen skal oprettes i undermappen og ikke i den normale mappe til kontaktpersoner.

På forhånd mange tak for hjælpen, jeg vender tilbage senere.

smads

Hvis mappen allerede findes, så er smørren følgende :-)

    Dim oOutlook As Outlook.Application
    Dim ns As NameSpace
    Dim fld As MAPIFolder
    Dim contact As ContactItem
    Set oOutlook = New Outlook.Application
    Set ns = oOutlook.GetNamespace("MAPI")
    Set fld = ns.GetDefaultFolder(olFolderContacts)
   
    Set fld = fld.Folders("test")
    Set contact = fld.Items.Add
   
    contact.CompanyName = "Target Gruppen ApS"
   
    contact.Save
   
    Set contact = Nothing
    Set ns = Nothing
    Set oOutlook = Nothing

VH CK

cFolder can be any sub folder to the contacts folder

Function OutlContact (cFolder as String)

Dim oApp As Outlook.Application
Dim oNameSpace As Outlook.NameSpace
Dim oFolder As MAPIFolder
Dim oWorkFolder  As MAPIFolder
Dim oItem As Outlook.ContactItem

   
    Set oApp = CreateObject("Outlook.Application")
    Set oNameSpace = oApp.GetNamespace("MAPI")
    Set oFolder = oNameSpace.GetDefaultFolder(olFolderContacts)
   
    Set oWorkFolder = oFolder.Folders(cFolder)
   
    Set oItem = oWorkFolder.Items.Add(olContactItem)

    oItem.FullName = "Your Contacts Full Name"
       

    oItem.Save
       
     
    Set oItem = Nothing
    Set oWorkFolder = Nothing
    Set oFolder = Nothing
    Set oNameSpace = Nothing
    Set oApp = Nothing

End Function

Tak for hjælpen :)