解压缩附件 - 运行时错误“91”

Question

我在另一个网站上找到了此代码。它应该在 Outlook 文件夹中找到一封电子邮件并解压缩附件。它使用一个临时位置来执行此操作。

我正在使用 Outlook 2013，我使用的参考是：Visual Basic for Application、Microsoft Outlook 15.0 对象库、OLE 自动化、Microsoft Office 15.0 对象库。我目前正在一个模块中运行此代码。

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

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

    For Each msg In SubFolder.Items
        For Each Atchmt In msg.Attachments
            If (Right(Atchmt.FileName, 3) = "zip") Then
                FileNameFolder = Environ("USERPROFILE") & "Documents\"
                Set oApp = CreateObject("Shell.Application")
                oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(Atchmt.FileName).Items
            End If
        Next
    Next
End Sub

我在这一行收到错误“对象变量或未设置块变量”。

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

Answer 1

我不得不改变

DIm oAPP as Object

到

Dim oApp as Shell

使用“Microsoft Shell 控件和自动化”进行早期绑定。不知道为什么它抱怨后期绑定

Answer 2

如果我们从 Outlook 对象模式讨论 Namespace 类，它不提供 CopyHere 方法。对象本身提供了登录和注销、通过ID直接访问存储对象、直接访问某些特殊的默认文件夹以及访问其他用户拥有的数据源的方法。使用 GetNamespace("MAPI") 从 Application 对象返回 Outlook NameSpace 对象。

CopyHere 方法将一个或多个项目复制到文件夹中。要复制的项目应作为参数传递。 这可以是表示文件名、FolderItem 对象或 FolderItems 对象的字符串。 但不能是附件文件名。您需要先将附件保存在磁盘上。

Answer 3

确保您的电子邮件收件箱中存在子文件夹（“Books”）并且“\Documents\Files\”将保存解压缩文件

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

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

    For Each msg In SubFolder.Items
        For Each Atchmt In msg.Attachments
            If (Right(Atchmt.FileName, 3) = "zip") Then
                FileNameFolder = Environ("USERPROFILE") & "\Documents\Files\"
                Atchmt.SaveAsFile FileNameFolder 
                Set oApp = CreateObject("Shell.Application")
                oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(Atchmt.FileName).Items
            End If
        Next
    Next
End Sub