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

我试图打开使用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低永成不在办公室（返回22 09 2014）.msg。

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

Answer 1

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

或者你可以find一个不错的VB解决scheme： 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

Answer 2

你应该检查下面的代码，并可以修改你的代码

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

Answer 3

尝试这个

 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 

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

Answer 4

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

Answer 5

Kenneth Li You打开文件时没有完整的path。 尝试这个：

 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