1

我正在尝试创建一些代码，将电子邮件正文复制到新的 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 中生成的表有关，但我不知道。

4

1 回答 1

0

您可以直接使用剪贴板，而不是尝试选择和复制。如果您的项目中有用户表单，则您已经拥有此参考集。如果没有，请设置对 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 中的显示方式，则将正文读入字符串，解析字符串以获得所需的数据，并将特定数据写入所需的单元格。

于 2013-10-17T21:40:33.047 回答