Outlook - Excel | HERBERS Excel Forum

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Private Sub ReadCalendarItems() Dim objApp As Outlook.Application Dim objNS As Namespace Dim objCalendar As MAPIFolder Dim objItem As AppointmentItem Dim strSubject As String Dim ObjRecipient As Recipient Set objApp = CreateObject("Outlook.Application") Set objNS = objApp.GetNamespace("MAPI") Set objCalendar = objNS.GetDefaultFolder(olFolderCalendar) For Each objItem In objCalendar.Items With objItem Debug.Print "Titel: " & .Subject & vbCrLf & _ "Am: " & .Start & " - " & .End & vbCrLf & _ "Dauer: " & IIf(.Duration = 1440, "Ganztägig", .Duration & " Minuten") & _ vbCrLf & _ "Body: " & .Body & vbCrLf & _ "Teilnehmer: " & .Recipients.Count If .Recipients.Count > 0 Then For Each ObjRecipient In .Recipients Debug.Print ObjRecipient.Name & " / " ' & ObjRecipient.Address Next End If End With Next End Sub

Hallo Dirk,
sorry für etwas verspätete Antwort.
Vielen Dank erstmal für Deinen Code.
Habe das Projekt in ein Modul eingefügt und bin aber auch nach langem hin - und herprobieren nicht weitergekommen.
1.) Ich kann das Modul nur in der Visual Basic Ansicht ausführen. Dann passiert auch was, aber unspezifisch d.h. es werden alle Termine im Direktbereich in der Visual Basic Anischt ausgegeben.
(Ist ja wahrscheinlich auch logisch, da ich nirgendwo einen Betreff eingebe).
Habe versucht, den Code in der Excel-Ansicht in ein Makro einzufügen und als Name ReadCalendarItems genommen, aber da kommt die Fehlermeldung, dass der Name mehrdeutig sei.
2.) Das eigentliche Problem ist aber noch, dass ich ja in Excel in eine Zelle z.B. A1 einen Betreff z.B. Mustermann bzw. Mustermann, Max eingeben will und dann soll der Termin zu diesem Betreff z.B. in die Zellen A4 etc. ausgegeben werden.
Vielleicht hört sich das ein wenig durcheinander an, deshalb fasse ich es nochmal kurz zusammen:
Also ich möchte in Zelle A1 einen Betreff eingeben und dann soll in Zelle A2 Sa 14.01.2012 und in Zelle A3 14:00 Uhr drinstehen und meinetwegen in Zelle A5 der body und das mithilfe eines Makros. Die Auswahl soll über den Betreff erfolgen.
Vielen Dank schonmal
LG Melek

Hallo Melek,
hier der Code der in das Modul MainBas gehört:
Sub ReadCalendarItems(Betreff As String)
Dim objApp As Outlook.Application
Dim objNS As Namespace
Dim objCalendar As MAPIFolder
Dim objItem As AppointmentItem
Dim strSubject As String
Dim ObjRecipient As Recipient
Dim i As Long
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objCalendar = objNS.GetDefaultFolder(olFolderCalendar)
i = 1
'Leere Blatt
Application.EnableEvents = False
Range("A4:Z5").ClearContents
Application.EnableEvents = True
For Each objItem In objCalendar.Items
With objItem
If InStr(1, LCase(.Subject), LCase(Betreff)) 0 Then
Application.EnableEvents = False
If InStr(1, .Start, " ") 0 Then
If Left(.Start, InStr(1, .Start, " ") - 1) = Left(.End, InStr(1, .Start, " ") - 1) Then
'Resultat in Zellen schreiben
Cells(2, i).Value = "Datum: " & Left(.Start, InStr(1, .Start, " ") - 1)
Else
Cells(2, i).Value = "Datum: " & Left(.Start, InStr(1, .Start, " ") - 1) & " - " & Left(.End, InStr(1, .Start, " ") - 1)
End If
Cells(3, i).Value = "Uhrzeit: " & Mid(.Start, InStr(1, .Start, " ") + 1) & " - " & Mid(.End, InStr(1, .Start, " ") + 1)
Else
Cells(2, i).Value = .Start
End If
Cells(4, i).Value = "Betreff: " & .Subject
Cells(5, i).Value = "Text: " & .Body
'Spalte formatieren
With Columns(i)
.ColumnWidth = 40
.Cells.Rows.AutoFit
.Cells.HorizontalAlignment = xlCenter
.Cells.VerticalAlignment = xlTop
End With
i = i + 1
Application.EnableEvents = True
End If
End With
Next
If i = 1 Then
MsgBox "Keine Eintraege gefunden", 16
Else
MsgBox "Kalender durchsucht und Daten übergeben!", 64
End If
End Sub
jetzt noch der Code, der in die Klasse Tabelle´1 gehört:

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("A1")) Is Nothing Then If Target.Value "" Then Call MainBas.ReadCalendarItems(Target.Value) Else 'Zelle ist leer, leere ausgabezellen Application.EnableEvents = False Range("A2:Z5").ClearContents Application.EnableEvents = True End If End If End Sub

Nun sollte nach einem Eintrag eines Betreffs in A1 + abschließender Enter-Taste das Makro starten und die entsprechenden Maildaten in die darunter befindlichen Zellen A2 bis A5 übertragen werden.
Gruß
Jochen

Beliebteste Forumthreads (12 Monate)

Outlook - Excel

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread