Termine nach aus Excel nach Outlook
06.08.2004 22:02:07
Peter
brauche mal wieder Hilfe
mit dem unten stehenden Makro werden meine Termine nach Outlook übertragen.
Es sollen in Spalte T alle leeren Zellen mit einer Schleife gesucht werden und dann der in Spalte S stehenden Termin in Outlook übernommen werden.
Funktioniert auch, nur das Problem nach der ersten gefundenen leeren Zelle in Spalte T werden alle Termine nach Outlook übertragen obwohl in Spalte T ein Wert eingetragen ist.
Weiß jemand wie ich das Problem lösen kann?
Beispiel: T23 leer dann wert aus S23
T34 leer dann wert aus S34
in meinem makro werden dann auch die termine aus S24 übertragen obwohl in T24 ein wert ist also nicht leer
vielen Dank im vorraus Gruß Peter
Sub Excel_Control_Termin_nach_Outlook()
Dim OutApp As Object, apptOutApp As Object
Set OutApp = CreateObject("Outlook.Application")
'Hier beginnen die Termine
Columns("T:T").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False).Activate
ActiveCell.Offset(0, -1).Activate
Do Until ActiveCell.Value = ""
Set apptOutApp = OutApp.CreateItem(1)
With apptOutApp
.Subject = Cells(ActiveCell.Row, 8) & " " & Cells(ActiveCell.Row, 9)
.Body = "Bereitstellung vom Bvh" & " " & Cells(ActiveCell.Row, 6)
.Location = Cells(ActiveCell.Row, 8)
.AllDayEvent = True
.Start = Format(ActiveCell - 5) & " 07:30"
.Duration = False
.ReminderMinutesBeforeStart = 10
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With
ActiveCell.Offset(1, 0).Select
Loop
Set apptOutApp = Nothing
Set OutApp = Nothing
MsgBox "Termine an Outlook übertragen!"
End Sub
Anzeige