AW: Formulare aus Outlook importieren
24.11.2005 16:59:22
Frank
Hallo Nine,
hier ein Lösungsansatz:
Sub sGetTermine()
Dim objMAPIFolder As MAPIFolder
Dim objAppt As AppointmentItem
Dim intRow As Integer
Dim ws As Worksheet
On Error Resume Next
'Use the pickfolder method to bring up the folder chooser
Set objMAPIFolder = GetNamespace("MAPI").PickFolder()
If Err = 0 Then
'Prfen, ob Cancel gedrückt wurde...
If objMAPIFolder Is Nothing Then
'Abbrcuh
Else
If objMAPIFolder.Items.Count = 0 Then Exit Sub
If objMAPIFolder.DefaultItemType = olAppointmentItem Then
Set ws = ActiveSheet
intRow = 1 ' Startzeile
For Each objAppt In objMAPIFolder.Items
With objAppt
Debug.Print .Start, .End
ws.Cells(intRow, "A").Value = .Start
ws.Cells(intRow, "B").Value = .End
ws.Cells(intRow, "C").Value = .Subject
' usw.
intRow = intRow + 1
End With
Next
Else
MsgBox "Bitte wählen Sie einen Kalender-Ordner aus!", vbExclamation
End If
End If
Else
MsgBox "Fehler #" & Err.Number & " " & Err.Description, vbCritical, "Outlook Fehler!"
End If
Set objMAPIFolder = Nothing
End Sub
Viel Spaß
Frank.