使用 Excel 中的 VBA 打开 Outlook 邮件 .msg 文件答案

【问题标题】：Open Outlook Mail .msg file using VBA from Excel使用 Excel 中的 VBA 打开 Outlook 邮件 .msg 文件
【发布时间】：2015-09-03 16:53:47
【问题描述】：

我正在尝试使用 VBA 从指定目录打开 .msg 文件，但我不断收到运行时错误。

我的代码：

Sub bla()
    Dim objOL As Object
    Dim Msg As Object
    Set objOL = CreateObject("Outlook.Application")
    inPath = "C:\Users\SiliconPlus\Desktop\Si+ Contact Lists\Contact_Si+"
    thisFile = Dir(inPath & "\*.msg")
    Set Msg = objOL.CreateItemFromTemplate(thisFile)
    ' now use msg to get at the email parts
    MsgBox Msg.Subject
    Set objOL = Nothing
    Set Msg = Nothing
End Sub

这是运行时错误：

运行时错误'-2147287038 (80030002)'：

无法打开文件：AUTO Andy Low Yong Cheng 不在办公室（返回 22 09 2014）.msg。

该文件可能不存在，您可能没有打开它的权限，或者它可能在另一个程序中打开。右键单击包含该文件的文件夹，然后单击属性以检查您对该文件夹的权限。

【问题讨论】：

刚刚重新编辑并发布了运行时错误thx
在继续之前，您是否实际调试过代码以查看thisFile 的值是多少？
如何调试这个文件你能教我吗
点击代码左侧的灰色竖条，它会高亮显示执行将进入调试模式的那一行。然后将鼠标放在您希望看到的变量上！ ;)
How do I open an outlook .msg file from my harddrive that is NOT in outlook? 的可能重复项

标签： excel vba outlook

【解决方案1】：

试试这个

Sub GetMSG()
' True includes subfolders
' False to check only listed folder
   ListFilesInFolder "C:\Users\lengkgan\Desktop\Testing", True
End Sub


Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim strFile, strFileType, strAttach As String
    Dim openMsg As MailItem

Dim objAttachments As Outlook.Attachments
Dim i As Long
Dim lngCount As Long
Dim strFolderpath As String

'where to save attachments
strFolderpath = "C:\Users\lengkgan\Desktop\Testing"

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    For Each FileItem In SourceFolder.Files

    strFile = FileItem.Name

' This code looks at the last 4 characters in a filename
' If we wanted more than .msg, we'd use Case Select statement
strFileType = LCase$(Right$(strFile, 4))
  If strFileType = ".msg" Then
    Debug.Print FileItem.Path

Set openMsg = Outlook.Application.CreateItemFromTemplate(FileItem.Path)
openMsg.Display
    'do whatever

Set objAttachments = openMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then

    For i = lngCount To 1 Step -1

    ' Get the file name.
    strAttach = objAttachments.Item(i).Filename

    ' Combine with the path to the Temp folder.
    strAttach = strFolderpath & strAttach

    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strAttach

    Next i
    End If
  openMsg.Close olDiscard

Set objAttachments = Nothing
Set openMsg = Nothing

' end do whatever
      End If
    Next FileItem
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, True
      Next SubFolder
    End If

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing

End Sub

已编辑：如何添加参考
单击工具 > 参考。检查所需的参考

【讨论】：

我得到一个编译错误：用户定义的类型没有用 FSO 定义作为 Scripting.FileSystemObject 突出显示，我需要导入任何东西/库等。
对不起，您需要添加 2 个参考：Microsoft Outlook 15.0 对象库和 Microsoft Scripting Runtime。
在 VBA 编辑器中单击工具 > 参考...。我添加了快照供您参考。
@keongkenshih 为什么要使用 FSO（Dir 轻得多）并保存所有附件，而不是询问？
我只有 Microsoft excel 12.0 对象库和 Microsoft Office 12.0 对象库。我在哪里下载 Microsoft Outlook 15.0 对象库？对不起>

【解决方案2】：

您应该检查以下代码并可以修改您的代码

Sub CreateFromTemplate() 
Dim MyItem As Outlook.MailItem 
Set MyItem = Application.CreateItemFromTemplate("C:\temp\*.msg") 
MyItem.Display 
End Sub

【讨论】：

【解决方案3】：

如果您遇到错误，请尝试在 MsgBox 下方的 Late Biding (Dim Msg As Object)（需要取消注释）：

Sub Kenneth_Li()
    Dim objOL As Outlook.Application
    Dim Msg As Outlook.MailItem
    Msgbox "If you get an error, try the Late Biding right under this (need to be uncommented)"
    'Dim objOL As Object
    'Dim Msg As Object

    Set objOL = CreateObject("Outlook.Application")
    inPath = "C:\Users\SiliconPlus\Desktop\Si+ Contact Lists\Contact_Si+"

    thisFile = LCase(Dir(inPath & "\*.msg"))
    Do While thisFile <> ""

        'Set Msg = objOL.CreateItemFromTemplate(thisFile)
        'Or
        'Set Msg = objOL.OpenSharedItem(thisFile)
        'Set Msg = GetNameSpace("MAPI").OpenSharedItem(thisFile)

        'Eventually with Shell command (here for notepad)
        'Shell "notepad " & thisFile
        Set Msg = objOL.Session.OpenSharedItem(thisFile)


        Msg.display

        MsgBox Msg.Subject
        thisFile = Dir
    Loop


    Set objOL = Nothing
    Set Msg = Nothing
End Sub

或者你可以在那里找到一个不错的 VB 解决方案：http://www.mrexcel.com/forum/excel-questions/551148-open-msg-file-using-visual-basic-applications.html#post2721847

这里有更多关于Shell方法的详细信息：http://p2p.wrox.com/access-vba/27776-how-open-msg-file-vbulletin.html#post138411

【讨论】：

感谢 R3uk。我目前无法访问 Outlook 库，因为我在 excel 2007 上，并且它在 vba 的参考部分中不包含此库
哦，是的，您当然可以在 Office 2007 上使用，只需在参考文献中搜索 Microsoft Outlook，如果还不够：stackoverflow.com/questions/24630378/…
我仍然收到错误无法打开文件：自动 Andy Low Yong Cheng 不在办公室（返回 22 09 2014）.msg。该文件可能不存在，您可能没有打开它的权限，或者它可能在另一个程序中打开。右键单击包含该文件的文件夹，然后单击属性以检查您对该文件夹的权限。 @R3uK 它检测到文件但无法打开它。
尝试重命名文件而不使用大写字母并重试代码？ stackoverflow.com/questions/25829685/… 如果可行，请将其重命名为大写并更改代码，以包含 thisFile = LCase(Dir(inPath & "\*.msg")) 而不是 thisFile = Dir(inPath & "\*.msg")
我能够成功修改此代码以将其用于我的应用程序。但是，我的代码将被可能有不同引用的多个用户使用，所以我使用了后期绑定：Dim objOL As Object & Dim Msg As Object。像魅力一样工作！

【解决方案4】：

另一种方法是以编程方式运行文件（在 VBA 中使用Shell 命令）。它将在 Outlook 中打开，您可以在其中打开项目的活动检查器窗口。

【讨论】：

【解决方案5】：

Kenneth Li You 打开文件时没有完整路径。试试这个：

Sub bla_OK()
Dim objOL As Object
Dim Msg As Object
Set objOL = CreateObject("Outlook.Application")
inPath = "C:\Users\SiliconPlus\Desktop\Si+ Contact Lists\Contact_Si+"
thisFile = Dir(inPath & "\*.msg")
'Set Msg = objOL.CreateItemFromTemplate(thisFile)
Set Msg = objOL.Session.OpenSharedItem(inPath & "\" & thisFile)
' now use msg to get at the email parts
MsgBox Msg.Subject
Set objOL = Nothing
Set Msg = Nothing
End Sub

【讨论】：