VBA在Outlook中解压文件

是否有任何outlook的VBA代码可以自动解压缩文件？我发现有几篇文章可以将文件保存到某个位置，但没有任何东西可以解压文件。

可能正是您要找的。网站示例（访问链接了解更多信息）：

在本例中，您可以浏览到zip文件。选择zip文件后，宏将在DefaultFilePath中创建一个新文件夹，并解压缩该文件夹中的zip文件。您可以在不做任何更改的情况下运行代码

Sub Unzip1（）
作为对象的Dim FSO
作为对象的Dim oApp
Dim Fname作为变体
Dim FileNameFolder作为变量
将路径设置为字符串
作为字符串的Dim strDate
Fname=Application.GetOpenFilename（文件过滤器：=“Zip文件（*.Zip），*.Zip”_
多选：=假）
如果Fname=False，则
“什么也不做
其他的
'新文件夹的根文件夹。
'您还可以使用DefPath=“C:\Users\Ron\test\”
DefPath=Application.DefaultFilePath
如果正确（DefPath，1）“\”则
DefPath=DefPath&“\”
如果结束
'创建文件夹名称
标准日期=格式（现在为“dd-mm-yy h-mm-ss”）
FileNameFolder=DefPath&“MyUnzipFolder”&strDate&“\”
'在DefPath中创建普通文件夹
MkDir文件名文件夹
'将文件解压缩到新创建的文件夹中
设置oApp=CreateObject（“Shell.Application”）
名称空间（FileNameFolder）.CopyHere oApp.Namespace（Fname）.items
'如果您只想提取一个文件，可以使用：
'oApp.Namespace（FileNameFolder.CopyHere_
'oApp.Namespace（Fname.items.Item（“test.txt”）
MsgBox“您可以在此处找到文件：”&FileNameFolder
出错时继续下一步
设置FSO=CreateObject（“scripting.filesystemobject”）
FSO.deletefolder环境（“Temp”）和“\Temporary Directory*”，True
如果结束
端接头

Sub Unzip1()
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String

    Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                        MultiSelect:=False)
    If Fname = False Then
        'Do nothing
    Else
        'Root folder for the new folder.
        'You can also use DefPath = "C:\Users\Ron\test\"
        DefPath = Application.DefaultFilePath
        If Right(DefPath, 1) <> "\" Then
            DefPath = DefPath & "\"
        End If

        'Create the folder name
        strDate = Format(Now, " dd-mm-yy h-mm-ss")
        FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"

        'Make the normal folder in DefPath
        MkDir FileNameFolder

        'Extract the files into the newly created folder
        Set oApp = CreateObject("Shell.Application")

        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

        'If you want to extract only one file you can use this:
        'oApp.Namespace(FileNameFolder).CopyHere _
         'oApp.Namespace(Fname).items.Item("test.txt")

        MsgBox "You find the files here: " & FileNameFolder

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
    End If
End Sub