返回列表 上一主題 發帖

請問vba使用系統內建來解壓縮zip??

lshsien

帖子
6 
主題
2 
精華
0 
積分
37 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2014-4-15 
最後登錄
2019-1-15 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-10-31 14:14 | 只看該作者

請問vba使用系統內建來解壓縮zip??

您好!
請教各位前輩
目前小弟想使用以下來解壓縮
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)
FileNameFolder = ThisWorkbook.Path & "\" & folder_name & "\"
Worksheets("工作表1").Range("F2") = FileNameFolder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
目前測試成功，
但使用這方式，還需選擇所需要解縮的檔案，
請問是否可以不需選擇而自行解壓縮
ps.檔案名稱與資料夾名稱擷取自Worksheets("工作表1").Range("F2")

載煩請各位前輩指導
謝謝
收藏 分享

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2014-11-1 01:12 | 只看該作者
回復 1# lshsien

試試看，是不是這樣?
  1.     Sub 解壓縮文件()
  2.         Dim Rarexe As String  'WINRAR執行文件的位置
  3.         Dim FileString As String 'Shell指令中的字符串
  4.         Dim Result As Long
  5.         Rarexe = "C:\program files\winrar\winrar"  'WINRAR執行文件的位置
  6.         '[B1]欄位 解壓縮前的原始文件
  7.         '[B2]欄位 解壓縮後的目地文件
  8.         FileString = Rarexe & " x " & "-Y " & [B1] & " " & [B2]  '指定-Y 開關，“是”為默認值，並自動回應全部的詢問。
  9.         Result = Shell(FileString, vbHide)
  10.     End Sub
複製代碼
還有另一個更便利的方法，但我功力不夠深厚，要請高手來幫忙了∼
程式碼如下，需另外貼在上面程式的最上方
這方法是直接點欄位，就會自動帶出路徑
  1. Option Explicit
  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  4.     Dim gb As FileDialog    '宣告一個檔案對話框
  5.     'Dim fd As FileDialog    '宣告一個檔案對話框

  7.     Set gb = Excel.Application.FileDialog(msoFileDialogFilePicker)  '設定選取檔案功能
  8.     'Set fd = Application.FileDialog(msoFileDialogFolderPicker)  '設定選取資料夾功能
  9.    
  10.     With Target(1)
  11.         If .Address = "$B$1" Then If gb.Show Then .Cells = gb.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
  12.         'If .Address = "$B$2" Then If fd.Show Then .Cells = fd.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
  13.     End With

  15. End Sub
複製代碼

解壓縮.rar (8.16 KB)

我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
3#
發表於 2014-11-3 19:43 | 只看該作者
回復 1# lshsien
你寫反了吧
Fname = Worksheets("工作表1").Range("F2").value          '從F2取得zip檔路徑
FileNameFolder = ThisWorkbook.Path & "\" & folder_name & "\"        '解壓縮位置
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

TOP

lshsien

帖子
6 
主題
2 
精華
0 
積分
37 
點名
0  
作業系統
win7 
軟體版本
office2010 
閱讀權限
10 
性別
男 
註冊時間
2014-4-15 
最後登錄
2019-1-15 
4#
發表於 2014-11-3 20:45 | 只看該作者
感謝蝕光迴狼大大
已經試驗成功了

感謝stillfish00更正

TOP

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
5#
發表於 2014-11-4 21:28 | 只看該作者
回復 4# lshsien


你用試成功的方法是
　可否分享一下，互相學習
我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
6#
發表於 2014-11-4 21:36 | 只看該作者
回復 3# stillfish00


stillfish00 大大：

　請問以下程式要怎麼改，才能兩個條件都成立，並正常執行程式?
  1. Option Explicit
  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3.     Dim gb As FileDialog    '宣告一個檔案對話框
  4.     'Dim fd As FileDialog    '宣告一個檔案對話框
  5.     Set gb = Excel.Application.FileDialog(msoFileDialogFilePicker)  '設定選取檔案功能
  6.     'Set fd = Application.FileDialog(msoFileDialogFolderPicker)  '設定選取資料夾功能
  7.     With Target(1)
  8.         If .Address = "$B$1" Then If gb.Show Then .Cells = gb.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
  9.         'If .Address = "$B$2" Then If fd.Show Then .Cells = fd.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
  10.     End With
  11. End Sub
複製代碼
我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
7#
發表於 2014-11-4 23:54 | 只看該作者
本帖最後由 stillfish00 於 2014-11-5 00:09 編輯

回復 6# 蝕光迴狼
若是一個檔案一個資料夾:
  1. Option Explicit
  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3.     Dim gb As FileDialog    '宣告一個檔案對話框
  4.     Dim fd As FileDialog    '宣告一個檔案對話框
  5.     With Target(1)
  6.         If .Address = "$B$1" Then
  7.             Set gb = Excel.Application.FileDialog(msoFileDialogFilePicker)  '設定選取檔案功能
  8.             If gb.Show Then .Cells = gb.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
  9.         ElseIf .Address = "$B$2" Then
  10.             Set fd = Application.FileDialog(msoFileDialogFolderPicker)  '設定選取資料夾功能
  11.             If fd.Show Then .Cells = fd.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
  12.         End If
  13.     End With
  14. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

蝕光迴狼
　暱稱: 蝕光迴狼

中學生Rank: 2

帖子
75 
主題
6 
精華
0 
積分
83 
點名
0  
作業系統
XP 
軟體版本
Office 2003 
閱讀權限
20 
性別
男 
來自
臺灣 
註冊時間
2014-9-22 
最後登錄
2015-3-7 

論壇榮譽勳章論壇贊助勳章
8#
發表於 2014-11-5 00:44 | 只看該作者
回復 7# stillfish00


    謝謝 stillfish00 大大的回答，可以正常執行了，萬分感謝∼
我很笨,所以我很用心
　我學藝不精,但我渴求知識

TOP

joey0415
　暱稱: joey0415

中學生Rank: 2

帖子
361 
主題
57 
精華
0 
積分
426 
點名
0  
作業系統
win7 
軟體版本
2003,2010 
閱讀權限
20 
性別
男 
註冊時間
2010-5-13 
最後登錄
2022-12-8 
9#
發表於 2018-2-21 21:03 | 只看該作者
單一檔案單一路徑解壓成功，留下紀錄參考參考！
  1. Sub vba_unzip()
  2.     Dim oApplicationlication As Object
  3.     Dim fileName As Variant
  4.     Dim folderFileName As Variant
  5.     'fileName = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)
  6.     fileName = "E:\期交所\opdata\OptionsDaily_2018_02_21.zip"
  7.     folderFileName = "e:\test\"
  8.     'MkDir folderFileName
  9.     Set oApplication = CreateObject("Shell.Application")
  10.     oApplication.Namespace(folderFileName).CopyHere oApplication.Namespace(fileName).items
  11.     DoEvents

  13. End Sub
複製代碼

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
返回列表 上一主題