Adressen nach Outlook-Kontakte-Unterordner
Wolfgang
ich kann über ein Makro meine Excel-Adressen in die Outlook-Kontakte übertragen (siehe Makro unten), aber ich will sie eigentlich in einen Unterordner von "Kontakte" schicken, mit dem Namen "Import".
Könnt Ihr mir da helfen, mein Makro anzupassen?
Danke schon mal im Voraus. Gruß, Wolfgang
Mein Makro:
___________________________________
Sub AdressenNachOutlook()
Dim anz As Integer
Dim qWks As Worksheet, i As Integer
Dim MyOutApp As Object, MyOutCon As Object
Set qWks = Worksheets("Kunden")
Set MyOutApp = CreateObject("Outlook.Application")
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
.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
.Birthday = Cells(i, 11).Value
.Email1Address = Cells(i, 12).Value
.Save
End With
Set MyOutCon = Nothing
Next i
End With
Set MyOutApp = Nothing
End Sub
_________________________________