Hi
I'm trying to write a VBA code in Excel that opens a folder (this folder will only contain Zip files) and from the zip archive open a xlsm file with same name as zip file, run some macros that are inside the xlsm file.
Then save it as a xlsx file (removing the macros in the file) and saving it back into the original zip file and deleteing the xlsm file.
This is to be repeted for all Zip file in selected folder.
The code for selcting folder works fine (as is the code to run macro inside xlsm file)
But I copied this Funtion from the web for unziping but I get an error on
Set objSource = _
objShell.Namespace(strZipFilename).Items.Item(CStr(strFilename))
As I'm sure you see I'm not very experience, to say the least.
I ussaly just take code from th web and apply to my needs, and mostly I get it to work, but i have never worked with Zip archives before
This is my total code so far, I have not addresed all processes yet, would be great if I could get support on the total scope
(Function and Sub is in the same Module, but that should not be un issue, right?)
' UnZip 1 file from a zip file:
'
Function entUnZip1File(ByVal strZipFilename, ByVal strDstDir, _
ByVal strFilename)
'
Const glngcCopyHereDisplayProgressBox = 256
'
Dim intOptions, objShell, objSource, objTarget
'
' Create the required Shell objects
Set objShell = CreateObject("Shell.Application")
'
' Create a reference to the files and folders in the ZIP file
Set objSource = _
objShell.Namespace(strZipFilename).Items.Item(CStr(strFilename))
'
' Create a reference to the target folder
Set objTarget = objShell.Namespace(strDstDir)
'
intOptions = glngcCopyHereDisplayProgressBox
'
' UnZIP the files
objTarget.CopyHere objSource, intOptions
'
' Release the objects
Set objSource = Nothing
Set objTarget = Nothing
Set objShell = Nothing
'
entUnZip1File = 1
'
End Function
Sub GetFileNames()
Dim xFolder As String 'Folder name
Dim xZipFile As String 'Archive (Zip) name
Dim xlsmFile As String 'File name inside archive
Dim InitialFoldr As String 'start folder for picking folder
InitialFoldr$ = "C:\Users\Michael\Desktop" '<<< Startup folder to begin searching from
'opens dialog box for picking folder
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & ""
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr
.Show
If .SelectedItems.count <> 0 Then
xFolder = .SelectedItems(1) & ""
xZipFile = Dir(xFolder, 7)
Do While xZipFile <> ""
xlsmFile = Left(xZipFile, Len(xZipFile) - 4) 'removes file extension, in this case ".zip"
'unziping selected file. file to unZip has the same name as archive but is an .xlsm file
entUnZip1File "xZipFile", "xFolder", "xFolder/xlsmFile.xlsm"
'code to run macro in xlsm file
Application.Run "'xlsmFile.xlsm'!Macro2"
xZipFile = Dir
Loop
End If
End With
End Sub
I'm trying to write a VBA code in Excel that opens a folder (this folder will only contain Zip files) and from the zip archive open a xlsm file with same name as zip file, run some macros that are inside the xlsm file.
Then save it as a xlsx file (removing the macros in the file) and saving it back into the original zip file and deleteing the xlsm file.
This is to be repeted for all Zip file in selected folder.
The code for selcting folder works fine (as is the code to run macro inside xlsm file)
But I copied this Funtion from the web for unziping but I get an error on
Set objSource = _
objShell.Namespace(strZipFilename).Items.Item(CStr(strFilename))
As I'm sure you see I'm not very experience, to say the least.
I ussaly just take code from th web and apply to my needs, and mostly I get it to work, but i have never worked with Zip archives before
This is my total code so far, I have not addresed all processes yet, would be great if I could get support on the total scope
(Function and Sub is in the same Module, but that should not be un issue, right?)
' UnZip 1 file from a zip file:
'
Function entUnZip1File(ByVal strZipFilename, ByVal strDstDir, _
ByVal strFilename)
'
Const glngcCopyHereDisplayProgressBox = 256
'
Dim intOptions, objShell, objSource, objTarget
'
' Create the required Shell objects
Set objShell = CreateObject("Shell.Application")
'
' Create a reference to the files and folders in the ZIP file
Set objSource = _
objShell.Namespace(strZipFilename).Items.Item(CStr(strFilename))
'
' Create a reference to the target folder
Set objTarget = objShell.Namespace(strDstDir)
'
intOptions = glngcCopyHereDisplayProgressBox
'
' UnZIP the files
objTarget.CopyHere objSource, intOptions
'
' Release the objects
Set objSource = Nothing
Set objTarget = Nothing
Set objShell = Nothing
'
entUnZip1File = 1
'
End Function
Sub GetFileNames()
Dim xFolder As String 'Folder name
Dim xZipFile As String 'Archive (Zip) name
Dim xlsmFile As String 'File name inside archive
Dim InitialFoldr As String 'start folder for picking folder
InitialFoldr$ = "C:\Users\Michael\Desktop" '<<< Startup folder to begin searching from
'opens dialog box for picking folder
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & ""
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr
.Show
If .SelectedItems.count <> 0 Then
xFolder = .SelectedItems(1) & ""
xZipFile = Dir(xFolder, 7)
Do While xZipFile <> ""
xlsmFile = Left(xZipFile, Len(xZipFile) - 4) 'removes file extension, in this case ".zip"
'unziping selected file. file to unZip has the same name as archive but is an .xlsm file
entUnZip1File "xZipFile", "xFolder", "xFolder/xlsmFile.xlsm"
'code to run macro in xlsm file
Application.Run "'xlsmFile.xlsm'!Macro2"
xZipFile = Dir
Loop
End If
End With
End Sub
