从 Outlook 邮件中提取压缩文件

Posted 2023-02-23

【中文标题】从 Outlook 邮件中提取压缩文件

【英文标题】：Extract Zipped file from Outlook mail

【发布时间】：2017-07-17 14:18:52

【问题描述】：

我正在尝试从我的 Outlook 邮件中提取一个 zip 文件。

以下是我的脚本，但它抛出了一个错误对象变量或未设置块变量。

开启

oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((Atchmt.FileName)).Items

我如何解决它。

Sub Unzip()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim Atchmt As Attachment
Dim FileName As String
Dim msg As Outlook.MailItem
Dim FileNameFolder As String
Dim FSO As Object               'variables for unzipping
Dim oApp As Object

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("TEST")

For Each msg In SubFolder.Items
   If msg.UnRead = True Then
        If LCase(msg.Subject) Like "*motor*" Then
            For Each Atchmt In msg.Attachments
                If (Right(Atchmt.FileName, 3) = "zip") Then
                MsgBox "1"
                        FileNameFolder = "C:\Users\xxxx\Documents\test\"
                        Set oApp = CreateObject("Shell.Application")
                        oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((Atchmt.FileName)).Items

                End If
            Next
        End If
    End If
Next
End Sub

【问题讨论】：

哪一行报错了？

oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((Atchmt.FileName)).Items

先保存压缩包再解压

是的，它按照你说的方式工作，但我只想要 csv 文件

解压文件后，终止 zip 文件。如果您需要有关如何终止 zip 的示例，请告诉我。

【参考方案1】：

先尝试保存压缩文件然后解压，如果你想delete压缩文件然后尝试Kill (zippath & zipname )

    Dim TempFile As String

    For Each msg In SubFolder.Items
       If msg.UnRead = True Then
            If LCase(msg.Subject) Like "*motor*" Then
                For Each Atchmt In msg.Attachments
                    If (Right(Atchmt.FileName, 3) = "zip") Then
'                    MsgBox "1"
                        FileNameFolder = "C:\Temp\Folders\"

                        Debug.Print FileNameFolder ' Immediate Window
                        Debug.Print Atchmt.FileName ' Immediate Window

                        TempFile = FileNameFolder & Atchmt.FileName

                        Atchmt.SaveAsFile TempFile

                        Set oApp = CreateObject("Shell.Application")
                        oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((Atchmt.FileName)).Items

                        Kill (TempFile)

                    End If
                Next
            End If
        End If
    Next

【讨论】：

这很有魅力！感谢您的帮助。

【参考方案2】：

将 msg 声明为通用对象 - 您可以在收件箱中包含 MailItem 以外的对象，例如 ReportItem 或 MeetingItem。

【讨论】：

新的错误是什么？引发该异常的代码的确切行是什么？

oApp.NameSpace((FileNameFolder)).CopyHere oApp.NameSpace((Atchmt.FileName)).Items - 未设置块变量 - 这是错误

你永远不会检查 oApp.NameSpace（第一个或第二个）是否真的返回了一个有效的对象。