On Error Resume Next?
16.08.2016 09:36:22
Berndt
folgende Frage:
Ab M2 stehen Kalenderdaten, ab N2 stehen die dazugehörigen Zeiten, und ab B2 steht der dazugehörige Betreff.
Habe dafür einen Code gefunden und umgeändert, der mir für diese 3 Daten einen Termin anlegt in Outlook. Außerdem sollen bereits erstellte Termine nicht mehrfach angelegt werden.
Funktioniert soweit super.
Hier der Code:
Sub Excel_Control_Termin_nach_Outlook()
Dim wksSheet As Worksheet
Dim objFolder As Object
Dim objOutApp As Object
Dim objTermin As Object
Dim lngRow As Long
On Error GoTo Fin
Set wksSheet = ThisWorkbook.Worksheets("project list") ' Anpassen!!!
Set objOutApp = CreateObject("Outlook.Application")
'9 = olFolderCalendar
Set objFolder = objOutApp.GetNamespace("MAPI").GetDefaultFolder(9)
For lngRow = 2 To Cells(Rows.Count, 13).End(xlUp).Row
If Not fncPointExist(objFolder, wksSheet.Cells(lngRow, 2).Value) Then
Set objTermin = objOutApp.CreateItem(1)
With objTermin
'Termine werden aus den Zellen gelesen
.Start = Format(wksSheet.Cells(lngRow, 13).Value _
, "dd.mm.yyyy") & " " & Format(wksSheet.Cells(lngRow, 14).Value, "hh:mm") 'Datum & Zeit
'Betreff
.Subject = wksSheet.Cells(lngRow, 2).Value
'Zusätzlicher Text
.Body = ""
'Ort
.Location = "Büro AV"
'Dauer des Ereignisses (hier 2 Stunden)
.Duration = "120"
'Erinnerung: 15 min vor Ereignis
.ReminderMinutesBeforeStart = 15
'Erinnerungsfunktion mit Sound
.ReminderPlaySound = True
'Erinnerung wiederholen
.ReminderSet = True
'Termin speichern
.Save
End With
Set objTermin = Nothing
End If
Next lngRow
Fin:
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
Set objFolder = Nothing
Set objTermin = Nothing
Set objOutApp = Nothing
If Err.Number = 0 Then MsgBox "Termine nach Outlook übertragen!"
End Sub
Private Function fncPointExist(ByVal objTMP As Object, _
ByVal strSubject As String) As Boolean
Dim objItem As Object
For Each objItem In objTMP.Items
If objItem.Subject = strSubject Then fncPointExist = True
Next
End Function
Es sollte zusätzlich rein:
"Wenn in einen der 3 Pflichtfelder (B,M,N) etwas fehlt (also Zelle leer ist), dann soll das Makro nicht abbrechen, sondern den Termin für diese Zeile nicht anlegen und somit zur nächsten Zeile gehen.
Klingt nach On Error resume next, oder?
Wo kann ich das einbinden?
Danke im voraus.
Berndt
Anzeige