通过shell机制查看回收站中文件原路径_VBA学习笔记50:文件压缩与解压缩

学习资源：《Excel VBA从入门到进阶》第50集 by兰色幻想

---

本节介绍如何使用VBA进行文件的压缩和解压缩。

一、shell函数

进行文件的压缩和解压缩需要调用压缩软件，所以这里需要用到Shell函数。

Shell函数执行一个可执行文件，返回一个 Variant (Double)。如果成功的话，代表这个程序的任务 ID，若不成功，则会返回 0。

Shell("可执行程序的路径 文件名或命令行",窗口的显示方式)
注意："可执行程序的路径 文件名或命令行" 中间的空格不可省略。

窗口的显示方式有以下几种：

窗口的显示方式

例：用绘图程序打开图片。（绘图程序mspaint.exe）

Sub 用绘图程序打开图片()
  Dim mysh
  mysh = Shell("mspaint.exe " & ThisWorkbook.Path & "pic.jpg", vbMaximizedFocus)
End Sub

本节主要学习命令行的编写。

二、WinRar命令行的表示

WinRar程序路径 命令 开关1 开关2 开关3..开关N 压缩包路径 压缩的文件路径

命令是指要进行怎么样的操作，如A是压缩，X是解压缩。

开关是具体操作时的细节，如压缩是是否把原文件删除，是否添加密码等。

详细可以到WinRAR的帮助文件——命令行模式——命令，可以查看到WinRAR所有可使用的命令和参数，本节可选了几个比较常用的出来讲解。

命令的类型

****************************************************************************************

获取rar的安装路径：

①写一个function获取路径

Function GetSetupPath(AppName As String)
    Dim WSH As Object
    Set WSH = CreateObject("Wscript.Shell")
    GetSetupPath = WSH.RegRead("HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionApp Paths" & AppName & "Path")
    Set WSH = Nothing
End Function

②在立即窗口显示rar的安装路径

Sub 测试()
Debug.Print GetSetupPath("Winrar.exe")
End Sub

****************************************************************************************

（1）压缩单个文件

Sub RarFile() 
  Dim Rarexe As String
  Dim myRAR As String
  Dim Myfile As String
  Dim FileString As String
  Dim Result As Long
    Rarexe = "C:Program FilesWinRARWinRAR.exe" 'Rarexe存放rar程序路径
    myRAR = ThisWorkbook.Path & "A.rar"  '压缩后的文件名
    Myfile = ThisWorkbook.Path & "B*.xls"     ' 指定要压缩的文件
    FileString = Rarexe & " A " & myRAR & " " & Myfile 
    'rar程序的A命令压缩文件的字符串，注意A前面是有空格的，不能省略
    Result = Shell(FileString, vbHide) '执行压缩
End Sub

执行结果显示

如果文件名使用通配符，可以对同类的文件进行和压缩。

如果只有路径没有文件名,则会把这个文件夹进行压缩。

（2）压缩多个文件

Sub RarFile2()   '多个文件压在一起
  Dim Rarexe As String
  Dim myRAR As String
  Dim Myfile As String
  Dim FileString As String
  Dim Result As Long
    Rarexe = "C:program fileswinrarwinrar.exe" 'rar程序路径
    myRAR = ThisWorkbook.Path & "B.rar"  '压缩后的文件名
    'Myfile = ThisWorkbook.path & "B*.xls"     ' 指定要压缩的文件类型
    Myfile = ThisWorkbook.Path & "B"     ' 指定要压缩的文件夹路径
    FileString = Rarexe & " A " & myRAR & " " & Myfile 'rar程序的A命令压缩文件的字符串
    Result = Shell(FileString, vbHide) '执行压缩
End Sub

三、压缩文件路径

在上一个例子中压缩文件打开后的文件路径有很多层。因为命令行没有写-ep、-ep1，默认带上完整的文件路径。

这样查看起来非常不方便，所以我们在命令行加上开关。

开关：-ep、-ep1

-ep压缩时忽略路径
-ep1压缩时忽略基准路径

把上一个例子的压缩命令行加上开关-ep。（这里为了方便查看就不展示所有代码了，其实只对了这句做了修改）

FileString = Rarexe & " A -ep " & myRAR & " " & Myfile 'rar程序的A命令压缩文件的字符串

运行结果展示：

不再有一层一层的文件夹路径，把所有文件提取出来压缩了。

接下来开关换成-ep1：（注意开关前面的空格绝对不能省）

FileString = Rarexe & " A -ep1 " & myRAR & " " & Myfile 'rar程序的A命令压缩文件的字符串

运行结果展示：

双击打开压缩包，显示的是B文件夹。

再双击进入，显示的是A文件夹和三个excel文件，和被压缩的原B文件夹文件的摆放顺序一样。所以-ep1只是省略上层路径，文件夹原先的路径保存，这种功能会较为常用。

四、添加压缩密码

开关：-p+、-hp+

-p密码：加密码后可以看到文件列表
-hp密码：加密码后无法看到文件列表

还是上面那个例子，我们修改一下命令行，把开关写为-p密码，密码设置为123，所以开关写法是"-p123"

FileString = Rarexe & " A -p123 " & myRAR & " " & Myfile

运行结果展示：

我们可以打开压缩包，看到文件夹里的内容，但一旦要打开压缩包里的文件，就会弹出输入密码的提示。

那么，我们改一下命令行，把开关写为-hp密码，密码设置依旧为123，所以开关写法是"-hp123"。

FileString = Rarexe & " A -hp123 " & myRAR & " " & Myfile

结果展示：

在想打开压缩包时，已经弹出了输入密码的窗口，无法看到压缩包里有什么文件。

五、压缩后删除源文件

开关：df、dr

df ：压缩后删除原文件，不可找回原文件。
dr ：压缩后删除原文件到回收站，可找回原文件，尽量使用dr。

首先让我们看看B文件夹的内容，里面有三个表格和一个文件夹。

修改命名行，把开关写为df。

FileString = Rarexe & " A -df -ep " & myRAR & " " & Myfile

结果展示：

生成了B压缩包，里面是B文件夹里的三个表格。

但是看回B文件夹，它原先的表格不见了，只看到孤零零的A文件夹，回收站里也没有文件。

改命令行的开关为-df：

FileString = Rarexe & " A -dr -ep " & myRAR & " " & Myfile

结果展示：

压缩包正常，而原B文件夹中的上excel文件被删除，但可以在回收站找过被删除的文件。

压缩包

excel表格被删除

六、压缩时排除

开关:-x

-x排除文件的完整路径：把多个文件压缩起来，但排除某个文件。

例：排除B文件夹中的1.xls和dr.xls。

FileString = Rarexe & " A -x" & ThisWorkbook.Path & "Bdr.xls -x" & ThisWorkbook.Path & "B1.xls -ep " & myRAR & " " & Myfile
    'rar程序的A命令压缩文件的字符串，排除dr和1工作簿，在要压缩的文件路径前面加-x

结果显示：

压缩包中只有2.xls，排除成功。

七、文件批量单独压缩

例：单独压缩B文件夹中的每一个文件。

方法：借助dir和do循环，压缩指定文件夹中的所有文件。

Sub RarFile4()   '每个文件单独压缩

Dim Rarexe As String
Dim myRAR As String
Dim Myfile As String
Dim FileString As String
Dim Result As Long
Dim p As String, f As String
 
p = ThisWorkbook.Path & "B"
Rarexe = "C:program fileswinrarwinrar.exe" 'rar程序路径
f = Dir(p & "*.xls")

Do While f <> ""
    f = Split(f, ".")(0)
    Myfile = ThisWorkbook.Path & "B" & f & ".xls"   ' 指定要压缩的文件
    myRAR = ThisWorkbook.Path & "B" & f & ".rar" '压缩后的文件名
    FileString = Rarexe & " A -ep " & myRAR & " " & Myfile 'rar程序的A命令压缩文件的字符串
    Result = Shell(FileString, vbHide) '执行压缩
   f = Dir
Loop

End Sub

八、从压缩包中删除指定文件

开关：D

D 要删除的文件:可以删除指定文件。

例：删除B文件夹中的"说明.txt"。

Sub RarFile3()   '

Dim Rarexe As String
Dim myRAR As String
Dim Myfile As String
Dim FileString As String
Dim Result As Long
    
Rarexe = "C:program fileswinrarwinrar.exe" 'rar程序路径
myRAR = ThisWorkbook.Path & "BB.rar"  '在删除的压缩包名称
Myfile = ThisWorkbook.Path & "B说明.txt"     ' 指定要删除的文件
FileString = Rarexe & " D " & myRAR & " " & "说明.txt" 'rar程序的A命令压缩文件的字符串
Result = Shell(FileString, vbHide) '执行程序

End Sub

九、解压缩

开关：x

x 解压文件：可将压缩包还原。

Sub RarFile2()   '解压缩

Dim Rarexe As String
Dim myRAR As String
Dim Myfile As String
Dim FileString As String
Dim Result As Long

Rarexe = "C:program fileswinrarwinrar.exe" 'rar程序路径
myRAR = ThisWorkbook.Path & "B.rar"  '压缩后的文件名
Myfile = ThisWorkbook.Path & "B"     ' 要解压缩的文件
FileString = Rarexe & " x -p123 " & myRAR & " " & Myfile
Result = Shell(FileString, vbHide) '执行压缩

End Sub

十、小结

一不小心都隔了将近一个月，捂脸）压缩功能还可能平时用得不多，但还哥记下的捐款