如何解决将所有电子邮件的正文提取到Outlook文件夹中
我需要将Outlook文件夹中的所有电子邮件的正文提取到Excel电子表格中。我希望每个电子邮件正文都可以在excel文件中创建一个新的工作表。
我有一个VBA宏,可以导出 SINGLE 电子邮件的正文内容,但是如何获取它以继续移动到Outlook文件夹中的下一封电子邮件并附加excel文件等等。 ?
这是将单个电子邮件的正文导出到excel的代码。
Sub ExportToExcel()
Dim xExcel As Excel.Application
Dim xWb As Workbook
Dim xWs As Worksheet
Dim xInspector As Inspector
Dim xItem As Object
Dim xMailItem As MailItem
Dim xDoc As Document
Dim xShell As Object
Dim xFilePath As String
On Error Resume Next
Set xShell = CreateObject("Shell.Application")
Set xFolder = xShell.BrowseForFolder(0,"Select a Folder:",0)
If TypeName(xFolder) = "Nothing" Then Exit Sub
Set xFolderItem = xFolder.Self
xFilePath = xFolderItem.Path & "\"
Set xItem = Outlook.Application.ActiveExplorer.Selection.Item(1)
If xItem.Class <> olMail Then Exit Sub
Set xMailItem = xItem
Set xInspector = xMailItem.GetInspector
Set xDoc = xInspector.WordEditor
xDoc.Application.Selection.Range.Copy
xInspector.Close olDiscard
Set xExcel = New Excel.Application
Set xWb = xExcel.Workbooks.Add
Set xWs = xWb.Sheets.Item(1)
xExcel.Visible = False
xWs.Activate
xWs.Paste
xWs.SaveAs xFilePath & "Daily Totals.xlsx"
xWb.Close True
xExcel.Quit
Set xWs = Nothing
Set xWb = Nothing
Set xExcel = Nothing
End Sub
感谢您的帮助。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。