2016-05-03 18 views
2

Ich arbeite an einem Projekt, das Outlook-Besprechungen und Termine von einem Outlook-Kalender mit einer formatierten Excel-Tabelle verknüpft. Ich bin in der Lage, die Outlook Termine/Meetings ohne Problem mit VBA zu ziehen. Das heißt, wenn die Ereignisse gezogen werden, wird ein Teil des Inhalts aus dem Körper nicht nach Excel exportiert, speziell ein eingebettetes Excel-Arbeitsblattobjekt. Mein Ziel ist es, das eingebettete Excel-Blatt mit einer eigenständigen Excel-Datei zu verknüpfen, die als Dashboard dient.HTMLBody Workaround für OlAppointment-Objekt?

Der Code, den ich bisher habe, ist in der Lage, den Absender, das Termindatum und die Bodymeldung der Outlook-Einladung zu ziehen. Das Problem ist, dass ich das eingebettete Excel-Blatt nicht dazu bringen kann, nach Excel zu exportieren. Wenn dies in einer E-Mail wäre, weiß ich, dass ich die .HTMLBody-Eigenschaft verwenden und die Daten, die als Tabelle markiert wurden, abrufen kann. Da ich jedoch mit olAppointmentItems und nicht mit MailItems arbeite, denke ich, dass die HTMLBody-Eigenschaft keine Option ist.

Ich hoffe, dass jemand mich in die Richtung einer Problemumgehung zeigen kann, die es mir ermöglicht, das eingebettete Arbeitsblattobjekt in Outlook zu ziehen. Die relevanten Teile des Codes, den ich ausführe, sind unten und ich erhalte eine Fehlermeldung, die angibt, dass das olAppointments-Objekt die .HTMLBody-Eigenschaft nicht unterstützt. Die Variablen im Call in the Public Sub sind Zellen in der Excel-Tabelle, in der sich das Makro befindet.

Alle Vorschläge würden sehr geschätzt werden. Vielen Dank!

Public Sub ExtractAppointments_ForPublic() 
With Worksheets("Calendar") 
    Call GetCalData(.Range("dtFrom").Value, .Range("dtTo").Value) 
End With 
End Sub 

Private Sub GetCalData(StartDate As Date, Optional EndDate As Date) 
'Source: http://www.codeforexcelandoutlook.com/blog/2008/08/extract-calendar-data-from-outlook-into-excel/ 
' ------------------------------------------------- 
' Notes: 
' If Outlook is not open, it still works, but much slower (~8 secs vs. 2 secs w/ Outlook open). 
' Make sure to reference the Outlook object library before running the code 
' End Date is optional, if you want to pull from only one day, use: Call GetCalData("7/14/2008") 
' ------------------------------------------------- 

Dim olApp As Object 
Dim olNS As Object 
Dim objRecipient As Object 
Dim myCalItems As Object 
Dim ItemstoCheck As Object 
Dim ThisAppt As Object 
Dim MyItem As Object 
Dim StringToCheck As String 
Dim MyBook As Excel.Workbook 
Dim rngStart As Excel.Range 
Dim strTable As String 
Dim strSharedMailboxName As String 
Dim i As Long 
Dim NextRow As Long 
Dim wsTarget As Worksheet 

Set MyBook = Excel.ThisWorkbook 

'<------------------------------------------------------------------ 
'Set names of worksheets, tables and mailboxes here! 
Set wsTarget = MyBook.Worksheets("Calendar") 
strTable = "tblCalendar" 
strSharedMailboxName = wsTarget.Range("mailbox").Value 
'------------------------------------------------------------------> 

Set rngStart = wsTarget.Range(strTable).Cells(1, 1) 

'Clear out previous data 
With wsTarget.Range(strTable) 
    If .Rows.Count > 1 Then .Rows.Delete 
End With 

' if no end date was specified, then the requestor only wants one day, so set EndDate = StartDate 
' this will let us return appts from multiple dates, if the requestor does in fact set an appropriate end date 
If EndDate = "12:00:00 AM" Then 
    EndDate = StartDate 
End If 

If EndDate < StartDate Then 
    MsgBox "Those dates seem switched, please check them and try again.", vbInformation 
    GoTo ExitProc 
End If 

If EndDate - StartDate > 28 Then 
    ' ask if the requestor wants so much info 
    If MsgBox("This could take some time. Continue anyway?", vbInformation + vbYesNo) = vbNo Then 
     GoTo ExitProc 
    End If 
End If 

' get or create Outlook object and make sure it exists before continuing 
On Error Resume Next 
Set olApp = GetObject(, "Outlook.Application") 
If Err.Number <> 0 Then 
    Set olApp = CreateObject("Outlook.Application") 
End If 
On Error GoTo 0 
If olApp Is Nothing Then 
    MsgBox "Cannot start Outlook.", vbExclamation 
    GoTo ExitProc 
End If 

Set olNS = olApp.GetNamespace("MAPI") 

' link to shared calendar 
Set objRecipient = olNS.CreateRecipient(strSharedMailboxName) 
objRecipient.Resolve 
Set myCalItems = olNS.GetSharedDefaultFolder(objRecipient, 9).Items '9=olFolderCalendar 

With myCalItems 
    .Sort "[Start]", False 
    .IncludeRecurrences = True 
End With 

StringToCheck = "[Start] >= " & Chr(34) & StartDate & " 12:00 AM" & Chr(34) & " AND [End] <= " & _ 
       Chr(34) & EndDate & " 11:59 PM" & Chr(34) 

Set ItemstoCheck = myCalItems.Restrict(StringToCheck) 

If ItemstoCheck.Count > 0 Then 
    ' we found at least one appt 
    ' check if there are actually any items in the collection, otherwise exit 
    If ItemstoCheck.Item(1) Is Nothing Then GoTo ExitProc 

    For Each MyItem In ItemstoCheck 
     If MyItem.Class = 26 Then ' 26=olAppointment. See https://msdn.microsoft.com/en-us/library/office/ff863329.aspx 
      ' MyItem is the appointment or meeting item we want, 
      ' set obj reference to it 

      Set ThisAppt = MyItem 

      ' see https://msdn.microsoft.com/en-us/library/office/dn320241.aspx for documentation 

      With rngStart 

        .Offset(NextRow, 0).Value = ThisAppt.Subject 
        .Offset(NextRow, 1).Value = ThisAppt.Organizer 
        .Offset(NextRow, 2).Value = Format(ThisAppt.Start, "MM/DD/YYYY") 
        .Offset(NextRow, 3).Value = ThisAppt.Body 

        'I need something here that will let me access the table in the 
        'Outlook invite. See the Function I below as what I was thinking before I came across the issue above.            

       NextRow = wsTarget.Range(strTable).Rows.Count 

      End With 
     End If 
    Next MyItem 

Else 
    MsgBox "There are no appointments or meetings during" & _ 
      "the time you specified. Exiting now.", vbCritical 
End If 

ExitProc: 
Set myCalItems = Nothing 
Set ItemstoCheck = Nothing 
Set olNS = Nothing 
Set olApp = Nothing 
Set rngStart = Nothing 
Set ThisAppt = Nothing 
End Sub 

Function GetTableAsHTML(Meeting As Object, OutputLoc As Excel.Range) 
    If Meeting.Class = 26 Then '#26 is defined as olAppointment 
    Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument 
    Dim oElColl As MSHTML.IHTMLElementCollection 
    With oHTML 
     On Error GoTo 0 
     .Body = Meeting.HTMLBody 
     On Error GoTo 0 
     Set oElColl = .getElementsByTagName("table") 
    End With 

    Dim x As Long, y As Long 

    For x = 0 To oElColl(0).Rows.Length - 1 
     For y = 0 To oElColl(0).Rows(x).Cells.Length - 1 
      Range(OutputLoc).Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText 
     Next y 
    Next x 
End If 


End Function 

Antwort

1

Ich weiß nicht, ob dies viel geholfen, aber ich hatte Probleme mit nicht eine Reihe von meiner Excel-Datei einfügen zu können (zum Beispiel eine Tabelle) zu einem Termin. Sie haben recht, wenn dies ein E-Mail-Objekt wäre, gäbe es die Möglichkeit, die .HTMLBody-Eigenschaft zu verwenden.

Da dies ein Termin ist, haben Sie "kopieren & einfügen" Ihren zuvor ausgewählten Bereich in Ihren Termin.

Dies ist, was für mich gearbeitet:

Sub MakeApptWithRangeBody() 

Dim olApp As Outlook.Application 
Dim olApt As Outlook.AppointmentItem 

Const wdPASTERTF As Long = 1 

Set olApp = Outlook.Application 
Set olApt = olApp.CreateItem(olAppointmentItem) 

With olApt 
    .Start = Now + 1 
    .End = Now + 1.2 
    .Subject = "Test Appointment" 
    Sheet1.ListObjects(1).Range.Copy 
    .Display 
    .GetInspector.WordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF 
End With 

End Sub 

Wie funktioniert es?

Im Gegensatz zu E-Mail hat das AppointmentItem keine HTMLBody -Eigenschaft. Wenn dies der Fall wäre, würde ich den Bereich in HTML konvertieren und diese Eigenschaft verwenden. Formatierter Text im Textkörper eines AppointmentItem ist Rich Text Format (RTF). Ich kenne keine guten Möglichkeiten, einen Bereich zu RTF zu konvertieren. Sicher, Sie könnten lernen, was alle RTF-Codes sind und erstellen Sie die Zeichenfolge in die RTFBody-Eigenschaft des AppointmentItem zu setzen. Dann können Sie zum Zahnarzt für einen No-Novocaine-Wurzelkanal gehen. Ich bin nicht sicher, welche von denen mehr Spaß machen würde.

Er hat recht, ich habe versucht, mit der RTF-Syntax zu arbeiten, die schrecklich ist.

Ein besserer Weg ist es, den Bereich programmatisch zu kopieren und in den Körper des Termins einzufügen. Seit Office 2007 können Sie fast jedes Outlook Objekt in Word verfassen. Das ist eine Option, die ich schnell aus, aber es ist immer noch da unter der Haube. Wir werden das zu unserem Vorteil nutzen.

Bitte beachten Sie die Originalquelle für weitere Informationen: Inserting a Range into an Outlook Appointment

Hoffnung, dass Sie irgendwie hilft.