使用 Excel 中的 VBA 打开 Outlook Mail .msg 文件

Open Outlook Mail .msg file using VBA from Excel

提问by Kenneth Li

I'm trying to open .msg files from a specified directory using VBAbut I keep getting a runtime error.

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

The code i have:

我有的代码：

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

Here is the runtime error:

这是运行时错误：

Run-time error '-2147287038 (80030002)':

Cannot open file: AUTO Andy Low Yong Cheng is out of the office (returning 22 09 2014).msg.

The file may not exist, you may not have permission to open it, or it may be open in another program. Right-click the folder that contains the file, and then click properties to check your permissions for the folder.

运行时错误“-2147287038 (80030002)”：

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

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

回答by Miguel

Kenneth Li You didn't had the full path when opening the file. Try this:

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

回答by R3uK

If you get an error, try the Late Biding(Dim Msg As Object) right under the MsgBox(need to be uncommented) :

如果出现错误，请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

Or you can find a nice VB solution there : http://www.mrexcel.com/forum/excel-questions/551148-open-msg-file-using-visual-basic-applications.html#post2721847

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

And here for more details on Shellmethod : http://p2p.wrox.com/access-vba/27776-how-open-msg-file-vbulletin.html#post138411

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

回答by Eugene Astafiev

Another way is to run the file programmatically (in VBA use the Shellcommand). It will be opened in Outlook where you can get an active inspector window with the item opened.

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

回答by keong kenshih

Try this

尝试这个

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

Edited : How to add the reference
Click Tools > Reference. Check the needed reference

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

回答by Khamill

You should check follow code and can modify your code

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

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