仅从电子邮件中提取 Excel 文档

问题描述

我有以下代码效果很好，可以从存储在文件夹中的所有电子邮件中提取附件。我只想从电子邮件中提取 .xlsx 文件。我不知道如何修改代码以仅选择 .xlsx 文件。

谢谢，

Public Sub Extract_Attachments_From_Outlook_Msg_Files()

    Dim outApp As Object
    Dim outEmail As Object
    Dim outAttachment As Object
    Dim msgFiles As String
    Dim sourceFolder As String
    Dim saveInFolder As String
    Dim fileName As String
    
    'CHANGE - folder location and filespec of .msg files
    msgFiles = ""
    'CHANGE - folder where extracted attachments are saved
    saveInFolder = ""
          
    On Error Resume Next
    Set outApp = Getobject(,"outlook.application")
    If outApp Is nothing Then
        MsgBox "Outlook is not open"
        Exit Sub
    End If
    On Error GoTo 0
    
    fileName = Dir(msgFiles)
    While fileName <> vbNullString
        
        'Open .msg file in Outlook 2003
        'Set outEmail = outApp.CreateItemFromTemplate(sourceFolder & fileName)
        
        'Open .msg file in Outlook 2007+
        Set outEmail = outApp.Session.OpenSharedItem(sourceFolder & fileName)
        
        For Each outAttachment In outEmail.Attachments
            outAttachment.SaveAsFile saveInFolder & outAttachment.fileName
        Next
    
        fileName = Dir
        
    Wend
    
End Sub

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）