Adressen->Outlook-Kontakte mit Foto
Wolfgang
aus einer Excel-Tabelle übertrage ich Adressangaben per Makro nach Outlook-2007, in den Kontakteordner "Import". Das funktioniert super.
Nur ich schaffe es nicht, auch Fotos, bzw. den Verweis/Ort des Fotos mitzuschicken, wie z.B. "c:\foto.jpg" für die erste Adresse. Die Information steht in einer Spalte der Adresse zur Verfügung.
Mit welcher Kennung kann ich diese Info an Outlook-2007 übergeben?
Mein-Makro_______________________________________________________
Sub AdressenNachOutlook_ohne_Geb_Erinnerung()
Dim mldg, stil, titel, antwort
mldg = "Sollen die Kontaktdaten wirklich nach Outlook (Kontakte: Unterordner ) ü _
bernommen werden?" ' Meldung definieren.
stil = vbYesNo + vbCritical + vbDefaultButton2 ' Schaltflächen definieren.
titel = "Achtung: Abfrage vor der Übernahme" ' Titel definieren.
antwort = MsgBox(mldg, stil, titel)
If antwort = 7 Then Exit Sub
Dim anz As Integer
Dim qWks As Worksheet, i As Integer, ii As Integer
Dim MyOutApp As Object, MyOutCon As Object
Dim myNameSpace As Object
Dim myContactFolder As Object
Dim myFolder As Object
On Error GoTo fehlermeldung
Set qWks = Worksheets("Kunden")
Set MyOutApp = CreateObject("Outlook.Application")
Set myNameSpace = MyOutApp.GetNameSpace("MAPI")
Set myContactFolder = myNameSpace.GetDefaultFolder(10)
Set myFolder = myContactFolder.Folders("Import")
Sheets("Kunden").Select
anz = Cells(1, 15)
With qWks
For i = 2 To anz
Set MyOutCon = MyOutApp.CreateItem(2)
With MyOutCon
.CompanyName = Cells(i, 1).Value & ", " & Cells(i, 11).Value
.FirstName = Cells(i, 3).Value
.LastName = Cells(i, 2).Value
.HomeAddressStreet = Cells(i, 4).Value
.HomeAddressPostalCode = Cells(i, 5).Value
.HomeAddressCity = Cells(i, 6).Value
.HomeAddressCountry = Cells(i, 7).Value
.HomeTelephoneNumber = Cells(i, 8).Value
.MobileTelephoneNumber = Cells(i, 9).Value
.Categories = Cells(i, 10).Value
.Email1Address = Cells(i, 12).Value
.department = Cells(i, 13).Value
.Save
.Move myFolder
End With
Set MyOutCon = Nothing
Next i
End With
Set MyOutApp = Nothing
GoTo beenden
fehlermeldung:
MsgBox "Fehler bei der Übergabe - ABBRUCH!! "
beenden:
End Sub
___________________________________________________
Danke schon mal im Voraus für die Unterstützung.
Gruß, Wolfgang
Anzeige