글 수 47
인터넷 서핑하다가 발견한 소스입니다.
VBA로 zip파일의 압축을 풀일이 얼마나 있을지는 모르겠지만..
일단 알아두면 언젠간 필요할 일이 있을 것 같네요.. ^^
출처 : http://www.rondebruin.nl/win/s7/win002.htm
Example 1 _ *.zip파일 압축 풀기..With this example you can browse to the zip file. After you select the zip file the macro will create a new folder in your DefaultFilePath and unzip the Zip file in that folder. You can run the code without any changes. Sub Unzip1() Dim FSO As Object Dim oApp As Object Dim Fname As Variant Dim FileNameFolder As Variant Dim DefPath As String Dim strDate As String Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _ MultiSelect:=False) If Fname = False Then 'Do nothing Else 'Root folder for the new folder. 'You can also use DefPath = "C:\Users\Ron\test\" DefPath = Application.DefaultFilePath If Right(DefPath, 1) <> "\" Then DefPath = DefPath & "\" End If 'Create the folder name strDate = Format(Now, " dd-mm-yy h-mm-ss") FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\" 'Make the normal folder in DefPath MkDir FileNameFolder 'Extract the files into the newly created folder Set oApp = CreateObject("Shell.Application") oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items 'If you want to extract only one file you can use this: 'oApp.Namespace(FileNameFolder).CopyHere _ 'oApp.Namespace(Fname).items.Item("test.txt") MsgBox "You find the files here: " & FileNameFolder On Error Resume Next Set FSO = CreateObject("scripting.filesystemobject") FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True End If End Sub |
참고로..
zip파일을 만드는 코드는 아래와 같다.
출처 : http://www.rondebruin.nl/win/s7/win001.htm
Code used by every example macro on this pageEvery macro use the sub NewZip and the first example also use both functions. Sub NewZip(sPath) 'Create empty Zip File 'Changed by keepITcool Dec-12-2005 If Len(Dir(sPath)) > 0 Then Kill sPath Open sPath For Output As #1 Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) Close #1 End Sub Function bIsBookOpen(ByRef szBookName As String) As Boolean ' Rob Bovey On Error Resume Next bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing) End Function Function Split97(sStr As Variant, sdelim As String) As Variant 'Tom Ogilvy Split97 = Evaluate("{""" & _ Application.Substitute(sStr, sdelim, """,""") & """}") End Function
ExamplesThere are five examples on this page that you can copy in a normal module of your workbook. Sub Zip_File_Or_Files() Dim strDate As String, DefPath As String, sFName As String Dim oApp As Object, iCtr As Long, I As Integer Dim FName, vArr, FileNameZip DefPath = Application.DefaultFilePath If Right(DefPath, 1) <> "\" Then DefPath = DefPath & "\" End If strDate = Format(Now, " dd-mmm-yy h-mm-ss") FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip" 'Browse to the file(s), use the Ctrl key to select more files FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _ MultiSelect:=True, Title:="Select the files you want to zip") If IsArray(FName) = False Then 'do nothing Else 'Create empty Zip File NewZip (FileNameZip) Set oApp = CreateObject("Shell.Application") I = 0 For iCtr = LBound(FName) To UBound(FName) vArr = Split97(FName(iCtr), "\") sFName = vArr(UBound(vArr)) If bIsBookOpen(sFName) Then MsgBox "You can't zip a file that is open!" & vbLf & _ "Please close it and try again: " & FName(iCtr) Else 'Copy the file to the compressed folder I = I + 1 oApp.Namespace(FileNameZip).CopyHere FName(iCtr) 'Keep script waiting until Compressing is done On Error Resume Next Do Until oApp.Namespace(FileNameZip).items.Count = I Application.Wait (Now + TimeValue("0:00:01")) Loop On Error GoTo 0 End If Next iCtr MsgBox "You find the zipfile here: " & FileNameZip End If End Sub |
2024.06.27 00:44:51 (*.243.127.73)
'#2024-06-27. 압축파일의 특정 폴더 내의 특정 파일만 추출할 경우. by abyul.com
Sub UnzipFile()
'From. https://officetricks.com/unzip-file-vba-excel-macro/
'Define Variable Data Types
Dim zipFileName As String
Dim unZipFolderName As String
Dim objZipItems As FolderItems
Dim objZipItem As FolderItem
'Set Zip File Name & Folder path to Unzip
zipFileName = "C:\Temp\zipTest.zip\xl"
unZipFolderName = "C:\Temp\Extract"
'Early Binding Reference
'Add Tools -> Reference -> "Microsoft Shell Controls & Automation"
Dim wShApp As Shell 'Shell타입으로 선언하지 않고 Object로 선언하면 에러가 난다.
Set wShApp = CreateObject("Shell.Application")
Set objZipItems = wShApp.Namespace(zipFileName).Items
'해당 폴더 전체 파일 추출
'wShApp.Namespace(unZipFolderName).CopyHere objZipItems
'특정 파일 하나만 추출
wShApp.Namespace(unZipFolderName).CopyHere objZipItems.Item(0)
End Sub
VBA창의 도구 > 참조 > "Microsoft Shell Controls And Automation"를 참조시켜준 다음,