1

I am trying to extract the content from an E-Mail in Outlook to an Excel table via VBA.

The E-Mail is for holiday management.
In the subject, there are always the keywords "Accepted holiday - Mr. James" Mr. James is the name of the employee, which holidays were accepted. So the keywords "Accepted holiday" is always the same, but the name always changes.
The E-Mail contains a long table, but there is only the end needed. Maybe it's the best, if it is searching for some keywords.

Datum von 18.12.2014
Datum bis 18.12.2014
Tage 1

Excel file contains:

  • List item

  • The lines 1 and 2 are empty.

  • The line 3 contains the dates from the year.

  • Line 4 contains Mo, Tue, Wed, Thur, Fr, Sat, Sun

  • Line 5 is empty

  • Line A6, A7, A8, .... contains the workers names

  • And then in the lines 6, 7, 8,... there should be "X" for the days, in which the worker has holidays.

Const xlUp As Long = -4162

Sub ExportToExcel(MyMail As MailItem)
    Dim strID As String, olNS As Outlook.Namespace
    Dim olMail As Outlook.MailItem
    Dim strFileName As String

    '~~> Excel Variables
    Dim oXLApp As Object, oXLwb As Object, oXLws As Object
    Dim lRow As Long

    strID = MyMail.EntryID
    Set olNS = Application.GetNamespace("MAPI")
    Set olMail = olNS.GetItemFromID(strID)

    '~~> Establish an EXCEL application object
    On Error Resume Next
    Set oXLApp = GetObject(, "Excel.Application")

    '~~> If not found then create new instance
    If Err.Number <> 0 Then
        Set oXLApp = CreateObject("Excel.Application")
    End If
    Err.Clear
    On Error GoTo 0

    '~~> Show Excel
    oXLApp.Visible = True

    '~~> Open the relevant file
    Set oXLwb = oXLApp.Workbooks.Open("C:\Sample.xls")

    '~~> Set the relevant output sheet. Change as applicable
    Set oXLws = oXLwb.Sheets("Sheet1")

    lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 1

    '~~> Write to outlook
    With oXLws
        '
        '~~> Code here to output data from email to Excel File
        '~~> For example
        '
        .Range("A" & lRow).Value = olMail.Subject
        .Range("B" & lRow).Value = olMail.SenderName
        '
    End With

    '~~> Close and Clean up Excel
    oXLwb.Close (True)
    oXLApp.Quit
    Set oXLws = Nothing
    Set oXLwb = Nothing
    Set oXLApp = Nothing

    Set olMail = Nothing
    Set olNS = Nothing
End Sub
eglease
  • 2,445
  • 11
  • 18
  • 28

1 Answers1

0

It looks like you need to automate Excel from Outlook. The How to automate Microsoft Excel from Visual Basic article describes all the required steps.

Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45