Ich schreibe grade für einen Freund ein Makro welches Kontakte in Outlook aus Daten von einem Excelfile erstellen soll.
Funktioniert mit dem untenstehenden code auch ganz gut.
Kann mir jemand erklären wie ich den code modifizieren muss, dass die kontakte in einem Ordner angelegt werden und nicht in den standart kontakte ordner erstellt werden? Danke!
Public Function olAddContact(ByVal sLastName As String, _
Optional ByVal sFirstName As String, _
Optional ByVal sCompanyName As String, _
Optional sPhoneNumber As String, _
Optional ByVal sEMail As String, _
Optional ByVal sWebPage As String) As Boolean
' Neuen Outlook-Kontakt hinzufügen
Dim oOutlook As Object ' Outlook.Application
Dim oNameSpace As Object ' Outlook.NameSpace
Dim oMAPIFolder As Object ' Outlook.MAPIFolder
Dim oContact As Object ' Outlook.ContactItem
Const olFolderContacts = 10
' Fehlerbehandlung aktivieren
On Error GoTo ErrHandler
' Outlook-Application-Objekt erstellen
Set oOutlook = CreateObject("Outlook.Application")
' Namespace initialisieren
Set oNameSpace = oOutlook.GetNamespace("MAPI")
' Kontakt-Ordner verwenden
Set oMAPIFolder = oNameSpace.GetDefaultFolder(olFolderContacts)
' Objekt für neuen Eintrag erstellen
Set oContact = oMAPIFolder.Items.Add
With oContact
' Eigenschaften des Eintrag festlegen
.LastName = Trim$(sLastName)
.FirstName = Trim$(sFirstName)
.CompanyName = Trim$(sCompanyName)
.PrimaryTelephoneNumber = Trim$(sPhoneNumber)
.Email1Address = Trim$(sEMail)
.WebPage = Trim$(sWebPage)
' hier können natürlich noch weitere Eigenschaften
' für den neuen Kontakt festgelegt werden, wie z.B.
' HomeAddressStreet, HomeAddressCity, etc.
' (siehe hierzu VB-Objekt-Katalog - Outlook - ContactItem)
' ...
' Kontakt speichern
.Save
End With
olAddContact = True
ErrHandler:
If Err.Number <> 0 Then
MsgBox "Fehler beim Erstellen des Outlook-Kontakts." & vbCrLf & _
CStr(Err.Number) & " " & Err.Description, vbExclamation + vbOKOnly
olAddContact = False
End If
' Objekte wieder freigeben
Set oContact = Nothing
Set oMAPIFolder = Nothing
Set oNameSpace = Nothing
Set oOutlook = Nothing
End Function