从Excel使用VBA打开Outlook邮件.msg文件

Question

我正在尝试使用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不在办公室（将于2014年9月22日返回）。msg。该文件可能不存在，您可能没有打开它的权限，或者它可能正在另一个程序中打开。右键单击包含该文件的文件夹，然后单击属性以检查您对该文件夹的权限。”

- Kenneth Li

---

刚刚重新编辑并发布了运行时错误，谢谢。 - Kenneth Li

你是否已经调试过代码，查看thisFile的值再继续进行呢？ - SierraOscar

这个文件怎么调试，你能教我吗？ - Kenneth Li

点击代码左侧的灰色垂直条，它会突出显示进入调试模式的行。然后将鼠标放在您想要查看的变量上！;) - R3uK

可能是重复的问题：如何从硬盘中打开一个不在Outlook中的Outlook .msg文件？ - R3uK

Answer 1

Kenneth Li在打开文件时没有提供完整的路径。请尝试以下操作：

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

- Miguel

Answer 2

如果出现错误，请尝试延迟绑定（Dim Msg As Object）放在MsgBox下面，需要去掉注释。

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

---

非常感谢R3uk。我目前无法访问Outlook库，因为我使用的是Excel 2007，而在VBA的引用部分中它并不包含此库。 - Kenneth Li

我仍然遇到一个错误：无法打开文件：AUTO Andy Low Yong Cheng is out of the office (returning 22 09 2014).msg。该文件可能不存在，您可能没有权限打开它，或者它可能在另一个程序中打开。右键单击包含该文件的文件夹，然后单击属性以检查您对文件夹的权限。@R3uK 它检测到该文件，但无法打开它。 - Kenneth Li

好的，现在试试看，我认为这可能是因为它应该与NameSpace对象一起使用。 - R3uK

我成功地修改了这段代码以用于我的应用程序。然而，我的代码将被多个用户使用，他们可能具有不同的引用，因此我使用了后期绑定：Dim objOL As Object和Dim Msg As Object。效果非常好！ - TheEngineer

@KennethLi：你能测试一下迟绑定吗？ - R3uK

Answer 3

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

- Eugene Astafiev

Answer 4

试试这个

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

编辑：如何添加引用
点击工具 > 引用。 勾选所需引用

- keong kenshih

---

点击 VBA 编辑器中的“工具”>“引用”。我已经添加了截图供您参考。 - keong kenshih

@keongkenshih 为什么要使用 FSO（Dir 更轻量级），并保存所有附件，而这并没有被要求？ - R3uK

我只有 Microsoft Excel 12.0 对象库和 Microsoft Office 12.0 对象库。我在哪里可以下载 Microsoft Outlook 15.0 对象库？抱歉 >< - Kenneth Li

我正在使用Excel 2013，也许你可以尝试包含该参考以检查它是否能够工作。理论上来说，这不应该是一个问题。 - keong kenshih

我目前使用的是Excel 2007，但在引用部分找不到Microsoft Outlook 15.0对象库的参考。是否有地方可以下载或将其实现到我的2007中？ - Kenneth Li

Answer 5

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

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

- Khamill