mohsan_akhtar
New Member
- Joined
- Jan 9, 2019
- Messages
- 7
Hi all,
I have been looking at RDB ZIP code for a while now, and can get most of the code to work, except for the actual zipping of the existing files into the newly created ZIP folder.
After stepping through the code - it seems to me that - the code is not recognising the ne ZIP folder.
In terms of the code amendments, I have just added some "prints" to the immediate window, and trying to have the file path (origin and output) set from use defined in cell C3 as shown in the screenshots. From the immediate window, all looks good. I am assuming that the dimming as a variable (Filenamezip) is the bit that is falling over, and I just can not seem to see where from...fresh pair of eyes would be appreciated ;
immediate window results [all as expected];
FROM EXCEL CELL C2:
X:\VARNew\Mohsan\WIP\Misc Macro\ZIP Test
FROM EXCEL - CHECKING '\' PRESENT:
X:\VARNew\Mohsan\WIP\Misc Macro\ZIP Test\
FROM EXCEL CELL C3 FORMULA:
ZIP Test 090119.zip
Zipping path (oPth)
X:\VARNew\Mohsan\WIP\Misc Macro\ZIP Test\
Namespace
X:\VARNew\Mohsan\WIP\Misc Macro\ZIP TestZIP Test 090119.zip
as a side note, I will probably get rid of the browse file part, as FP supplied by user - keeping in for testing.
Excel in WS;
[TABLE="width: 298"]
<tbody>[TR]
[TD="width: 151, bgcolor: transparent"]FP to ZIP
[/TD]
[TD="width: 247, bgcolor: transparent"]X:\VARNew\Mohsan\WIP\Misc Macro
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Partial name to save as
[/TD]
[TD="bgcolor: transparent"]Misc Macro
[/TD]
[/TR]
</tbody>[/TABLE]
C3 contains formula to get the result =MID(C2,FIND("=",SUBSTITUTE(C2,"","=",LEN(C2)-LEN(SUBSTITUTE(C2,"",""))))+1,256)
I have been looking at RDB ZIP code for a while now, and can get most of the code to work, except for the actual zipping of the existing files into the newly created ZIP folder.
After stepping through the code - it seems to me that - the code is not recognising the ne ZIP folder.
In terms of the code amendments, I have just added some "prints" to the immediate window, and trying to have the file path (origin and output) set from use defined in cell C3 as shown in the screenshots. From the immediate window, all looks good. I am assuming that the dimming as a variable (Filenamezip) is the bit that is falling over, and I just can not seem to see where from...fresh pair of eyes would be appreciated ;
Code:
''Browse to a folder and zip all files in it
Sub NewZip(sPath)
'Create empty Zip File
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL]
Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL]
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function Split97(sStr As Variant, sdelim As String) As Variant
Split97 = Evaluate("{""" & Application.Substitute(sStr, sdelim, """,""") & """}")
End Function
Sub Zip_All_Files_in_Folder_Browse()
Dim FileNameZip As Variant, FolderName, oFolder
Dim strDate As String, DefPath As String, oPth As Variant
Dim oApp As Object
Dim ZIPwb As Workbook
Dim Control As Worksheet
Dim DefFPusr As Range, DefOutname As Range
Set ZIPwb = ThisWorkbook
Set Control = ZIPwb.Sheets("CONTROL")
Set DefFPusr = Control.Range("C2")
Set DefOutname = Control.Range("C3")
DefPath = DefFPusr.Value
Debug.Print "FROM EXCEL CELL C2: "; Tab(10); DefPath 'for testing only
If Right(DefPath, 1) <> "" Then
DefPath = DefPath & ""
End If
Debug.Print strindent; "FROM EXCEL - CHECKING '\' PRESENT: "; Tab(10); DefPath 'for testing only
strDate = Format(Now, " ddmmyy")
FileNameZip = DefOutname & strDate & ".zip"
Debug.Print "FROM EXCEL CELL C3 FORMULA: "; Tab(10); FileNameZip 'for testing only
Set oApp = CreateObject("Shell.Application")
'Browse to the folder - ************** amended to go to specicif folder
oPth = DefPath
Debug.Print "Zipping path (oPth)"; Tab(10); oPth 'for testing only
Set oFolder = oApp.BrowseForFolder(0, "Please choose a folder...", 512, oPth)
If Not oFolder Is Nothing Then
'Create empty Zip File
NewZip (FileNameZip)
'FolderName
oPth = oFolder.Self.Path
If Right(FolderName, 1) <> "" Then
FolderName = FolderName & ""
End If
'Copy the files to the compressed folder
Debug.Print "Namespace "; Tab(10); oPth & FileNameZip
'************* the code is breaking here - runtime error 91 - Object variable or with block not set **************************
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(oPth).Items
'************************************************************************************************************
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).Items.Count = oApp.Namespace(FolderName).Items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
MsgBox "You can find the zipfile here: " & FileNameZip, vbInformation, "ZIP Processing complete :)"
End If
End Subimmediate window results [all as expected];
FROM EXCEL CELL C2:
X:\VARNew\Mohsan\WIP\Misc Macro\ZIP Test
FROM EXCEL - CHECKING '\' PRESENT:
X:\VARNew\Mohsan\WIP\Misc Macro\ZIP Test\
FROM EXCEL CELL C3 FORMULA:
ZIP Test 090119.zip
Zipping path (oPth)
X:\VARNew\Mohsan\WIP\Misc Macro\ZIP Test\
Namespace
X:\VARNew\Mohsan\WIP\Misc Macro\ZIP TestZIP Test 090119.zip
as a side note, I will probably get rid of the browse file part, as FP supplied by user - keeping in for testing.
Excel in WS;
[TABLE="width: 298"]
<tbody>[TR]
[TD="width: 151, bgcolor: transparent"]FP to ZIP
[/TD]
[TD="width: 247, bgcolor: transparent"]X:\VARNew\Mohsan\WIP\Misc Macro
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Partial name to save as
[/TD]
[TD="bgcolor: transparent"]Misc Macro
[/TD]
[/TR]
</tbody>[/TABLE]
C3 contains formula to get the result =MID(C2,FIND("=",SUBSTITUTE(C2,"","=",LEN(C2)-LEN(SUBSTITUTE(C2,"",""))))+1,256)
