標題:
請問vba使用系統內建來解壓縮zip??
[打印本頁]
作者:
lshsien
時間:
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")
載煩請各位前輩指導
謝謝
作者:
蝕光迴狼
時間:
2014-11-1 01:12
回復
1#
lshsien
試試看，是不是這樣?
Sub 解壓縮文件()
Dim Rarexe As String 'WINRAR執行文件的位置
Dim FileString As String 'Shell指令中的字符串
Dim Result As Long
Rarexe = "C:\program files\winrar\winrar" 'WINRAR執行文件的位置
'[B1]欄位 解壓縮前的原始文件
'[B2]欄位 解壓縮後的目地文件
FileString = Rarexe & " x " & "-Y " & [B1] & " " & [B2] '指定-Y 開關，“是”為默認值，並自動回應全部的詢問。
Result = Shell(FileString, vbHide)
End Sub
複製代碼
還有另一個更便利的方法，但我功力不夠深厚，要請高手來幫忙了∼
程式碼如下，需另外貼在上面程式的最上方
這方法是直接點欄位，就會自動帶出路徑
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim gb As FileDialog '宣告一個檔案對話框
'Dim fd As FileDialog '宣告一個檔案對話框
Set gb = Excel.Application.FileDialog(msoFileDialogFilePicker) '設定選取檔案功能
'Set fd = Application.FileDialog(msoFileDialogFolderPicker) '設定選取資料夾功能
With Target(1)
If .Address = "$B$1" Then If gb.Show Then .Cells = gb.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
'If .Address = "$B$2" Then If fd.Show Then .Cells = fd.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
End With
End Sub
複製代碼
作者:
stillfish00
時間:
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
作者:
lshsien
時間:
2014-11-3 20:45
感謝蝕光迴狼大大
已經試驗成功了
感謝stillfish00更正
作者:
蝕光迴狼
時間:
2014-11-4 21:28
回復
4#
lshsien
你用試成功的方法是
可否分享一下，互相學習
作者:
蝕光迴狼
時間:
2014-11-4 21:36
回復
3#
stillfish00
stillfish00 大大：
請問以下程式要怎麼改，才能兩個條件都成立，並正常執行程式?
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim gb As FileDialog '宣告一個檔案對話框
'Dim fd As FileDialog '宣告一個檔案對話框
Set gb = Excel.Application.FileDialog(msoFileDialogFilePicker) '設定選取檔案功能
'Set fd = Application.FileDialog(msoFileDialogFolderPicker) '設定選取資料夾功能
With Target(1)
If .Address = "$B$1" Then If gb.Show Then .Cells = gb.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
'If .Address = "$B$2" Then If fd.Show Then .Cells = fd.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
End With
End Sub
複製代碼
作者:
stillfish00
時間:
2014-11-4 23:54
本帖最後由 stillfish00 於 2014-11-5 00:09 編輯
回復
6#
蝕光迴狼
若是一個檔案一個資料夾:
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim gb As FileDialog '宣告一個檔案對話框
Dim fd As FileDialog '宣告一個檔案對話框
With Target(1)
If .Address = "$B$1" Then
Set gb = Excel.Application.FileDialog(msoFileDialogFilePicker) '設定選取檔案功能
If gb.Show Then .Cells = gb.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
ElseIf .Address = "$B$2" Then
Set fd = Application.FileDialog(msoFileDialogFolderPicker) '設定選取資料夾功能
If fd.Show Then .Cells = fd.SelectedItems(1) '點選哪個欄位儲存格,檔案路徑秀在那個欄位
End If
End With
End Sub
複製代碼
作者:
蝕光迴狼
時間:
2014-11-5 00:44
回復
7#
stillfish00
謝謝 stillfish00 大大的回答，可以正常執行了，萬分感謝∼
作者:
joey0415
時間:
2018-2-21 21:03
單一檔案單一路徑解壓成功，留下紀錄參考參考！
Sub vba_unzip()
Dim oApplicationlication As Object
Dim fileName As Variant
Dim folderFileName As Variant
'fileName = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", MultiSelect:=False)
fileName = "E:\期交所\opdata\OptionsDaily_2018_02_21.zip"
folderFileName = "e:\test\"
'MkDir folderFileName
Set oApplication = CreateObject("Shell.Application")
oApplication.Namespace(folderFileName).CopyHere oApplication.Namespace(fileName).items
DoEvents
End Sub
複製代碼
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
