Send Email funktioniert nicht
18.03.2013 16:48:16
Kampe
ich habe folgenden Code, der das Datum als Spalte G auslesen soll. Wenn der Wert -3 Tage, ein Mittwoch ergibt, soll er eine Email verschicken.
Und wie´s der T* will, es geht nicht! Kann mir jemand helfen?
Sub Excel_Control_Termin_nach_Outlook()
Dim OutApp As Object, apptOutApp As Object
'Hier beginnen die Termine
Range("G3").Select
Do Until ActiveCell.Value = ""
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
With apptOutApp
'Datum und Uhrzeit
.Start = Format(ActiveCell.Value - 3, "dd.mm.yyyy")
'Termininfo
.Subject = "Anmeldung: " & lt.Statusliste
.Subject = ActiveCell.Offset(0, 1)
'Zusätzlicher Text
.Body = "Folgendes muss für die ..... angemeldet werden."
.Duration = "Mittwoch, 16:00 Uhr"
'Erinnerung
.ReminderMinutesBeforeStart = 10
'mit Sound
.ReminderPlaySound = True
'Erinnerung wiederholen
.ReminderSet = True
'Termin speichern
.Save
End With
'Nächste Zelle auswählen
ActiveCell.Offset(1, 0).Select
'Variablen leeren,...
Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
MsgBox "Termine an Outlook übertragen!"
End Sub
Anzeige