Private Sub CommandButton2_Click()
Dim outId As Integer
Dim outtask As Object
Dim myOutlook As Object
Dim conItem As Object
Set myOutlook = CreateObject("Outlook.Application")
Set outtask = myOutlook.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks).Folders( _
Sheets(2).Range("B8").Value)
For outId = outtask.Items.Count To 1 Step -1
'Zuweisen des Object für jeden Contact
Set conItem = outtask.Items(outId)
With conItem
.delete
End With
Next outId
End Sub
Sub Excel_an_Outlook_Aufgabe()
On Error GoTo ErrorAufgabe
Dim MyError As Integer
Dim Faellig As Date
Dim Link As String
Dim myolApp As Object, myitem As Object
'Eigene Fehleroutine/Nummer eröffnen
MyError = 1
'Fälligkeit ist übermorgen
MyError = 2
For i = 14 To Worksheets("Aufgaben").Cells(Rows.Count, 1).End(xlUp).Row
'If Cells(i, 6) = "" Then
Set myolApp = CreateObject("Outlook.Application")
Set myitem = myolApp.CreateItem(3)
Set myitem = myolApp.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks).Folders(Sheets(1). _
Range("F4").Value).CreateItem(3)
myitem.Subject = Cells(i, 1).Value ' Text der Aufgabe
myitem.Body = Cells(12, 6).Value & ": " & Cells(i, 6).Value
myitem.Companies = Cells(8, 2).Value & " " & Cells(7, 2).Value
myitem.StartDate = Cells(i, 3).Value
If Cells(i, 4).Value = "" Then
myitem.DueDate = "31.12.2100"
Else
myitem.DueDate = Cells(i, 4).Value
End If
If Cells(i, 5).Value "" Then
myitem.DateCompleted = Cells(i, 5).Value
End If
myitem.Save
Set myitem = Nothing
ErrorExit:
'End If
Next i
Exit Sub
ErrorAufgabe:
Select Case MyError
Case 1
MsgBox "Die Datei wurde noch nicht gespeichert"
Case 2
MsgBox "Outlook kann nicht gestartet werden" & Chr$(13) & "Aufgabe wurde nicht erstellt _
End Select
Resume ErrorExit
End Sub
Option Explicit
Sub Main()
Dim objFolder As Object
On Error GoTo Fin
Set objFolder = CreateObject("Outlook.Application").GetNamespace("MAPI") _
.GetDefaultFolder(13).Folders(Sheets(1).Range("F4").Value).Items.Add
With objFolder
.StartDate = Format(Now() + 4, "dd.mm.yyyy") & " 08:00"
.DueDate = Format(Now() + 8, "dd.mm.yyyy") & " 14:00"
.Subject = "Hier Dein Betreff!"
.Body = "Text im Body!"
.Save
End With
Fin:
Set objFolder = Nothing
If Err.Number 0 Then MsgBox "Error: " & _
Err.Number & " " & Err.Description
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen