Question

我试图打开保存在桌面文件夹（C：\ Desktop \ Index）中的msg（Outlook项目）文件，并搜索附件（单个/ zip文件）。

我得到了

“对象不支持此属性或方法”错误：

Set openMsg = Application.CreateItemFromTemplate(FileItem.Path)

Option Explicit

Sub GetMSG()
*True includes sub folders
*False to check only listed folder
   ListFilesInFolder "C:\Desktop\Index\", 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:\Desktop\Index\Attachments\"

    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 = 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 1

在错误之前写上这个：

Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate(FileItem.Path)

使用Application时，它是指Excel应用程序，而不是Outlook应用程序。而且Excel Application不支持CreateItemFromTemplate。

您还可以使用早期绑定：

Dim OutApp As New Outlook.Application
Set OutMail = OutApp.CreateItemFromTemplate(FileItem.Path)

如何从Excel打开文件系统中存储的Outlook消息？

1 个答案: