Question

我正在尝试创建一些代码，将电子邮件正文复制到新的Excel电子表格中。我有这段代码：

Public Sub ExportToExcel1()

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim myitem As Outlook.MailItem
Dim FileName As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim item As Object
Dim mai As MailItem

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox).Folders("Hold Info")
Set objSearchFolder = Inbox

i = 0
For Each item In Inbox.Items
    item.Display
    item.Body.Select
    Selection.Copy
    Dim xlApp As Object ' Excel.Application
    Dim xlWkb As Object ' Excel.Workbook
    Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
    Set xlWkb = xlApp.Workbooks.Add
    xlApp.Visible = True
    xlApp.Workbooks.Add
    xlApp.Selection.Paste False, False, False
Next 

End Sub

它一直在item.Body.Select给我一个错误，我不知道为什么。它可能与我试图复制的电子邮件只是在Oracle中生成的表格有关，但我不知道。

Answer 1

您可以直接使用剪贴板，而不是尝试选择和复制。如果项目中有用户表单，则表示已有此参考集。如果没有，请设置对Microsoft Forms 2.0对象库的引用。然后使用DataObject将一些文本放入剪贴板。

Public Sub ExportToExcel1()

    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim item As Object
    Dim doClip As MSForms.DataObject
    Dim xlApp As Object ' Excel.Application
    Dim xlWkb As Object

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox).Folders("Hold Info")
    Set doClip = New MSForms.DataObject

    For Each item In Inbox.Items
        If TypeName(item) = "MailItem" Then
            doClip.SetText item.Body
            doClip.PutInClipboard

            Set xlApp = CreateObject("Excel.Application") ' New Excel.Application
            xlApp.Visible = True
            Set xlWkb = xlApp.Workbooks.Add
            xlWkb.Sheets(1).Range("A1").PasteSpecial "Text"
        End If
    Next

End Sub

要考虑几点。以这种方式使用剪贴板时，您使用的是Windows剪贴板，而不是Office剪贴板。 Windows剪贴板无法识别Office特定的剪贴板格式，因此您在翻译方面会略有不足。

从剪贴板粘贴有一些优点。但是，如果要完全控制数据在Excel中的显示方式，请将Body读入字符串，解析所需数据的字符串，并将特定数据写入所需的单元格。

使用VBA将电子邮件中的表复制到Excel

1 个答案: