VBA壓縮與解壓縮源碼
- 2017-09-08 22:42:00
- 網絡摘録 轉貼
- 4571
VBA本身沒有壓縮和解壓縮的函數,但可調用zip.dll unzip.dll 或 winrar.exe 命令行方式來實現對文件的壓縮與解壓縮
Sub UnRarFile() '解壓縮程序 Dim Rarexe As String Dim RAR As String Dim Myadd As String Dim FileString As String Dim Result As Long Rarexe = "C:\program files\winrar\winrar.exe" 'rar程序路徑 myRAR = "D:\工資錶\*.rar" '需要解壓縮的rar文件,用通配符可以解壓所有文件 Myadd = "D:\工資錶" ' 解壓後的文件存放路徑 FileString = Rarexe & " X " & myRAR & " " & Myadd 'rar程序的X命令,用來解壓縮文件的字符串 Result = Shell(FileString, vbHide) '執行解壓縮 End Sub 運行效果: 把D盤的工資錶文件夾中的所有壓縮文件一次性解壓。 2、批量壓縮文件(一次性壓縮指定文件夾中所有xls文件) 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 files\winrar\winrar.exe" 'rar程序路徑 myRAR = "D:\工資錶\工資錶.rar" '壓縮後的文件名 Myfile = "D:\工資錶\*.xls" ' 指定要壓縮的文件 FileString = Rarexe & " A " & myRAR & " " & Myfile 'rar程序的A命令壓縮文件的字符串 Result = Shell(FileString, vbHide) '執行壓縮 End Sub ___________________________________________________________________________ Set oba = CreateObject("Wscript.shell") '[壓縮] oba.Run "winrar a c:\test.rar c:\*.txt",0,True '[解壓縮] oba.Run "winrar x -o+ C:\test.rar *.txt C:\test",0,True Set oba = Nothing |
文章分類
聯繫我們
聯繫人: | 王先生 |
---|---|
Email: | 18449932@qq.com |
QQ: | 18449932 |
微博: | officecn01 |