VBA解压文件和压缩文件函数

cidanji

操作电脑文件 解压和压缩

压缩方法
yasuo 压缩文件路径, 被压缩文件路径
如：yasuo "D:\A.rar", "D:\A.txt"   '此句把A.txt压缩成A.rar，放到D盘

解压方法
jieya 压缩文件路径, 解压到目标文件夹路径
如：jieya "D:\A.rar", "D:\"   '此句把A.rar内文件解压到D盘


调用例子

1. Sub 文件压缩测试()
   
2. yasuo "D:\A.rar", "D:\A.txt"
   
3. End Sub

复制代码

1. Sub 文件解压测试()
   
2. jieya "D:\A.rar", "D:"
   
3. End Sub

复制代码

解压\压缩函数

1. Function jieya(rarP$, foderP$)
   
2. Dim exeP$
   
3. exeP = GetSetupPath("WinRAR.exe")
   
4. If exeP = "" Then MsgBox "未安装 WinRAR 软件": Exit Function
   
5. Shell exeP & "\WinRAR.exe  X " & rarP & " " & foderP, vbHide
   
6. End Function
   
7. Function yasuo(rarP$, fileP$)
   
8. Dim exeP$
   
9. exeP = GetSetupPath("WinRAR.exe")
   
10. If exeP = "" Then MsgBox "未安装 WinRAR 软件": Exit Function
    
11. Shell exeP & "\WinRAR.exe A -ep " & rarP & " " & fileP, vbHide
    
12. End Function
    
13. Private Function GetSetupPath(AppName As String)
    
14. On Error Resume Next
    
15. Dim Wsh As Object
    
16. Set Wsh = CreateObject("Wscript.Shell")
    
17. GetSetupPath = Wsh.regread("HKEY_LOCAL_MACHINE\Software" & "\Microsoft\Windows\CurrentVersion\App Paths" & AppName & "\Path")
    
18. Set Wsh = Nothing
    
19. End Function

复制代码

ykcbf1100

感觉直接在当前路径下压缩和解压更方便一点，那样参数就不用带路径了。

沈默00

支持分享，学习一下

cidanji

ykcbf1100 发表于 2024-1-11 07:28
感觉直接在当前路径下压缩和解压更方便一点，那样参数就不用带路径了。

哈哈 对，我都没想到这样写

morpheus126

没有winrar就Exit Function。。。winrar装机量应该不是很大。。。个人估计

cidanji

morpheus126 发表于 2024-1-11 10:57
没有winrar就Exit Function。。。winrar装机量应该不是很大。。。个人估计

对，调用的winrar命令行 所以要有winrar软件，应用场景比较窄，比如面向特定用户开发的需要解压缩文件的工具里使用，来提示安装软件。
不用winrar也能操作，现在我只会压缩，写解压还不熟练，等哪天熟练了得空再分享不用winrar的解压缩方法

ztj277702035

GetSetupPath = Wsh.regread("HKEY_LOCAL_MACHINE\Software" & "\Microsoft\Windows\CurrentVersion\App Paths" & AppName & "\Path")这个？我装了winrar，但报错

『大卫』

ztj277702035 发表于 2024-6-6 08:47
GetSetupPath = Wsh.regread("HKEY_LOCAL_MACHINE\Software" & "\Microsoft\Windows\CurrentVersion\App Pa ...

GetSetupPath = Wsh.regread("HKEY_LOCAL_MACHINE\Software" & "\Microsoft\Windows\CurrentVersion\App Paths这里少个“\”  " & AppName & "\Path")