使用Excel中的VBA打开Outlook Mail .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.

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

Answer 1

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

Answer 2

尝试这个

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

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