weis jemand wie man unter den Aufgaben (OUTLOOK) in einem Unterordner per VBA aus Excel die alle eingetragenen Aufgaben löscht?
MFG
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
Servus