Automatisierter Minutesheader zwischen Outlook und Word

[kinimod2010]

Hallo Leute,

Ich habe mich heute mit der Verbindung zwischen Outlook und Word mittels VBA beschäftigt.
Die gute Nachricht ist, dass ich schon einen Text ins word einfügen kann.

Ziel:

Das Ziel von mir ist es eine Tabelle in Word zu erstellen wie hier:

Spoiler

[table="width: 500, class: grid, align: center"]
[tr]
[td]Datum:[/td]
[td]auto[/td]
[/tr]
[tr]
[td]Wo:[/td]
[td]auto[/td]
[/tr]
[tr]
[td]Zeit:[/td]
[td]auto[/td]
[/tr]
[tr]
[td]Wer Anwesend:[/td]
[td]auto[/td]
[/tr]
[tr]
[td]Um was geht es:[/td]
[td]auto[/td]
[/tr]
[/table]

Dort wo auto geschrieben ist soll sich das outlook die daten von meinen Terminen rausnehmen.

Leider habe ich noch nicht viel mit vba gearbeitet das auf andere office packete übergreift.

Mein zusammengefügter Code bis jetzt:

Spoiler

Sub CreateDocument()

    Dim WordApp As Word.Application
    Dim NewDocument As Word.Document
    
    Set WordApp = New Word.Application
    
    WordApp.Visible = True
    Set NewDocument = WordApp.Documents.Add(, , , True)
    Set objSelection = NewDocument.ActiveWindow.Selection
    Set myRange = Selection.Range
            
    ActiveDocument.Tables.Add Range:=myRange, NumRows:=3, NumColumns:=4 ' Weder die Zeile funktioniert '
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=10, _            ' Bzw. die Zeile funktioniert auch nicht'
        NumColumns:=5, DefaultTableBehavior:=wdWord8TableBehavior
        
    objSelection.TypeText "Text 1"    'Text in Word'
    objSelection.TypeParagraph        'Enter im Word'
    objSelection.TypeText "Text 2"
    objSelection.TypeParagraph
  
    
    WordApp.Visible = True

End Sub

ich weiß nicht mehr weiter könnt ihr mir bitte helfen?
Gruß kinimod

 

[C4rb0nFiber]

Erste Frage: Warum machst du 2 Beiträge zum gleichen Thema auf?

 

[kinimod2010]

Hallo Tresorgh,
Ich muss mich da beim Erstellen verdrückt haben ich weiß aber jetzt nicht wie ich das andere lösche
Ursprünglich wollte ich nur ein Thema aufmachen.
Ich werde mich darum kümmern und das iwie löschen. Danke für den Hinweiß.

Gruß kinimod2010

Ergänzung (20. Januar 2015)

Hallo Leute,

Ich habe mich heute nochmal den ganzen Tag gespielt und es funktioniert so einigermaßen:

Ich habe nur noch ein Problem: wenn die Termine hintereinander sind nimmt der immer den 2ten er soll aber den nächsten termin nehmen wenn jemand dazu was weiß bitte um eine kurze antwort.

Danke

Spoiler

 Sub FindApptsInTimeFrame()
    Dim myStart As Date
    Dim myEnd As Date
    Dim oCalendar As Outlook.Folder
    Dim oItems As Outlook.Items
    Dim oResItems As Outlook.Items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String
    
    Dim WordApp As Word.Application
    Dim NewDocument As Word.Document
    
    myStart = Date
    myStart = myStart + Time
    myEnd = DateAdd("h", 1, myStart)
    
    Set WordApp = New Word.Application
    Set oCalendar = Application.Session.GetDefaultFolder(olFolderCalendar)
    Set oItems = oCalendar.Items
    Set NewDocument = WordApp.Documents.Open("Pfad einfügen")  'Hier Pfad einfügen'
    Set objSelection = NewDocument.ActiveWindow.Selection
     
    oItems.IncludeRecurrences = True
    oItems.Sort "[Start]"
     
    strRestriction = "[Start] <= '" & Format$(myEnd, "mm/dd/yyyy hh:mm") _
    & "' AND [End] >= '" & Format(myStart, "mm/dd/yyyy hh:mm") & "'"
    Debug.Print strRestriction
     
    'Restrict the Items collection
    Set oResItems = oItems.Restrict(strRestriction)
     
    For Each oAppt In oResItems
         'Debug.Print oAppt.Start, oAppt.Subject & vbCrLf & _'
         '              "Place:   " & oAppt.Location & vbCrLf & _'
         '              "Subject: " & oAppt.Subject & vbCrLf & _'
         '              "Start: " & oAppt.Start & vbCrLf & _'
         '              "Participants: " & oAppt.Recipients.Count''
                       
       WordApp.ActiveDocument.Tables(1).Cell(1, 1).Range.Text = "Date:"
       WordApp.ActiveDocument.Tables(1).Cell(1, 2).Range.Text = Format(oAppt.Start, "DD/MM/YYYY")
       WordApp.ActiveDocument.Tables(1).Cell(2, 1).Range.Text = "Place: "
       WordApp.ActiveDocument.Tables(1).Cell(2, 2).Range.Text = oAppt.Location
       WordApp.ActiveDocument.Tables(1).Cell(3, 1).Range.Text = "Time:"
       WordApp.ActiveDocument.Tables(1).Cell(3, 2).Range.Text = Format(oAppt.Start, "HH:MM") & " - " & Format(oAppt.End, "HH:MM")
       WordApp.ActiveDocument.Tables(1).Cell(4, 1).Range.Text = "Participants: "
       WordApp.ActiveDocument.Tables(1).Cell(4, 2).Range.Text = " "
        If oAppt.Recipients.Count > 0 Then
              For Each ObjRecipient In oAppt.Recipients
                  WordApp.ActiveDocument.Tables(1).Cell(4, 2).Range.InsertAfter (ObjRecipient.Name & " / ") 
              Next
        End If
       
       WordApp.ActiveDocument.Tables(1).Cell(5, 1).Range.Text = "Distributin list: "
       WordApp.ActiveDocument.Tables(1).Cell(5, 2).Range.Text = " "
       WordApp.ActiveDocument.Tables(1).Cell(6, 1).Range.Text = "Subject: "
       WordApp.ActiveDocument.Tables(1).Cell(6, 2).Range.Text = oAppt.Subject
       WordApp.Visible = True

    Next
End Sub

Danke für eure Hilfe