如何从电子邮件(Outlook)中提取内容到excel表?

时间:2015-01-09 07:50:44

标签: excel vba email excel-vba outlook

我正在尝试通过VBA将Outlook中的电子邮件内容提取到Excel表格 电子邮件用于度假管理。
在主题中总是有关键词“接受假期 - 詹姆斯先生”詹姆斯先生是雇员的名字,哪些假期被接受。所以关键词“Accepted holiday”总是一样的,但名字总是会改变 电子邮件包含一个长表,但只有最终需要。 也许它是最好的,如果它正在搜索一些关键词 Datum von 18.12.2014
Datum bis 18.12.2014
Tage 1

我不知道,有哪些可能性,使用VBA 我是一个全新的人,这是我第一次使用VBA。
谢谢你的帮助。

真诚地,塞巴斯蒂安

Excel文件包含: 第1行和第2行是空的 第3行包含年份的日期 第4行包含Mo,Tue,Wed,Thur,Fr,Sat,Sun
第5行是空的 A6,A7,A8,......行包含工人姓名
然后在第6,7,8行......那天应该有“X”,工人有假期。

Const xlUp As Long = -4162

Sub ExportToExcel(MyMail As MailItem)     DIM strID As String,olNS As Outlook.Namespace     Dim olMail作为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

1 个答案:

答案 0 :(得分:0)

看起来您需要从Outlook自动化Excel。 How to automate Microsoft Excel from Visual Basic文章介绍了所有必需的步骤。