How to zip multiple files from one source folder to a destination folder in Windows 10 environment? 1

[feipezi]

Hello,
I guess the subject has made myself clear. If not please let me know what info needed.
Thanks in advance.

 

[strongm]

My code in thread222-1302498 may be of use. Whilst that is the Classic VB forum, the code should also work with little to no modification in VBScript

 

[feipezi]

Works like a charm!!
thanks.

 

[feipezi]

Hey strongm,
One more question. For Excle 2013, the following statements is not working, correct? I tried it and Excel cannot be opened.
thanks.


Option Explicit

Dim objExcel
Dim objWorkbook

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True
....
....

 

[feipezi]

Hello,
I took Strongm's code and it worked fine as I ran it in an Excel workbook.
However what I'm trying to do is to run it by calling a VBS code in Windows Explorer but I got errors like 'ByRef argument type mismatch'.
Thanks again.

Here is the code in a workbook: ziptest.xlsm



Private Sub ZipAll(pathname As String)
FolderName = pathname
CreateEmptyZip pathname & ".zip"

With CreateObject("Shell.Application")
' .NameSpace("c:\testzip.zip").CopyHere "c:\test.txt"
.Namespace(pathname & ".zip").CopyHere .Namespace(FolderName).items
End With
' All done!
End Sub


Public Sub CreateEmptyZip(sPath)
Dim strZIPHeader As String

strZIPHeader = Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
With CreateObject("Scripting.FileSystemObject")
.CreateTextFile(sPath).Write strZIPHeader
End With

End Sub

Sub RunIt()
ZipAll pathname
End Sub


The next is the code in a VBS pgm: RunZip.VBS



Option Explicit

Dim objExcel
Dim objWorkbook
Dim pathname

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

Set objWorkbook = objExcel.Workbooks.Open("C:\Users\John\Documents\VB\ziptest.xlsm")
pathname=inputbox("enter folder name:")

objWorkbook.Application.Run "ziptest.xlsm!RunIt"

objWorkbook.Save
objWorkbook.Close
objExcel.Quit

set objWorkbook = nothing
set objExcel = nothing

 

[strongm]

I am now confused. Are you trying to run this as VBScriopt, or just using VBscript to call some VBA in Excel?

Your 'ByRef argument type mismatch' is caused by the fact that you are not passing pathname from the VBscript bit to the VBA bit, and not using Option Explicit. But even if you successfully get over that you'll encounter some additional errors (e.g the code as written will try to zip the zip file into itself ...)

 

[feipezi]

Sorry about the confusion. Right, I was trying to 'use VBS to call some VBA in Excel'.
I understand why I got the error but I cannot figure out how to fix it.

I tested it if the code like the following, it will produce a Zip folder side by side with the original folder, under AGG in the example:


....
....
Sub RunIt()
ZipAll "C:\Users\pl04512\Documents\pnc\agg\from CX"
End Sub


Thanks again!

 

[strongm]

Realtively simple step:

[blue]Sub RunIt([b]pathname As String[/b])
    ZipAll pathname
End Sub[/blue]

and

[blue]
objWorkbook.Application.Run "ziptest.xlsm!RunIt"[b],  CStr(pathname)[/b]
[/blue]

 

[xwb]

You don't really need excel to do that - it can be done entirely in vbscript. Some variation of

const ForWriting = 2

if wscript.arguments.count < 2 then
    WScript.echo "Usage: <zipfile> <copydir>"
    WScript.quit
end if
set objFSO = CreateObject("Scripting.FileSystemObject")
zipfile = objFSO.GetAbsolutePathName(WScript.arguments(0))
copydir = objFSO.GetAbsolutePathName(WScript.arguments(1))

WScript.echo "Output: " & zipfile
WScript.echo "Input : " & copydir

' Create an empty zip file
set objZipfile = objFSO.OpenTextFile(zipfile, 2, VBTrue)
call objZipfile.Write("PK" & chr(5) & chr(6) & String(18,0))
objZipfile.Close

' Copy to zip file
set objShell = CreateObject("Shell.Application")
set dstdir = objShell.NameSpace(zipfile)
set srcs = objShell.NameSpace(copydir).items
dstdir.CopyHere srcs
do until dstdir.items.count = srcs.count
    WScript.Sleep 1000
loop

' Tidy up
set objShell = Nothing
set objFSO = Nothing

 

[strongm]

> it can be done entirely in vbscript.

Which is why I asked my previous question

 

[feipezi]

Thanks guys. I'd like to try both ways.

Strongm, I tried your VBS code to call the macros in the Excel workbook. It worked the first run; but after that, the zipped folder wouldn't exist.
Here is the VBS code that I used.
Thanks again.


Dim objExcel
dim objworkbook

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\pl04512\Documents\vba\vbs\ziptest.xlsm")
pathname = InputBox("Please Enter The Name Of The Folder To Be Zipped:")
objWorkbook.Application.Run "ziptest.xlsm!RunIt", CStr(pathname)

objWorkbook.Close
objExcel.Quit

set objWorkbook = nothing
set objExcel = nothing

 

[feipezi]

Hey xwb,

I tried your code too. Still the zipped folder won't show up. Any issues with the code below?
Thanks.


const ForWriting = 2

zipfile=inputbox("source foldr")
copydir=inputbox("copy dir")
if wscript.arguments.count < 2 then
WScript.echo "Usage: " & zipfile & " : " & copydir
WScript.quit
end if
set objFSO = CreateObject("Scripting.FileSystemObject")
zipfile = objFSO.GetAbsolutePathName(WScript.arguments(0))
copydir = objFSO.GetAbsolutePathName(WScript.arguments(1))

WScript.echo "Output: " & zipfile
WScript.echo "Input : " & copydir

' Create an empty zip file
set objZipfile = objFSO.OpenTextFile(zipfile, 2, VBTrue)
call objZipfile.Write("PK" & chr(5) & chr(6) & String(18,0))
objZipfile.Close

' Copy to zip file
set objShell = CreateObject("Shell.Application")
set dstdir = objShell.NameSpace(zipfile)
set srcs = objShell.NameSpace(copydir).items
dstdir.CopyHere srcs
do until dstdir.items.count = srcs.count
WScript.Sleep 10
loop

' Tidy up
set objShell = Nothing
set objFSO = Nothing

 

[xwb]

If you are not using WScript.Args, remove the check. Your polling is too quick. Change to 1s.

const ForWriting = 2

zipfile=inputbox("zip file")
copydir=inputbox("source dir")

set objFSO = CreateObject("Scripting.FileSystemObject")
zipfile = objFSO.GetAbsolutePathName(zipfile)
copydir = objFSO.GetAbsolutePathName(copydir)

WScript.echo "Output: " & zipfile
WScript.echo "Input : " & copydir

' Create an empty zip file
set objZipfile = objFSO.OpenTextFile(zipfile, ForWriting, VBTrue)
call objZipfile.Write("PK" & chr(5) & chr(6) & String(18,0))
objZipfile.Close

' Copy to zip file
set objShell = CreateObject("Shell.Application")
set dstdir = objShell.NameSpace(zipfile)
set srcs = objShell.NameSpace(copydir).items
dstdir.CopyHere srcs
do until dstdir.items.count = srcs.count
    ' Increase to 1s.
    Script.Sleep 1000
loop

' Tidy up
set objShell = Nothing
set objFSO = Nothing

 

[strongm]

The appearance or not of the zip file should have nothing to do with polling rates, since it is created before we actually try to zip anything.

So my question would be (silly as it might sound): are you sure that you are looking in the right place for the zip file?

 

[feipezi]

Hello guys,
Thanks for your reply.
I keep trying xwb's VBS way of zipping but I don't see the zipped folder. The folders that I tried are:
source dir: C:\Users\pl04512\Documents\pnc\agg\from CX
zip dir : C:\Users\pl04512\Documents\pnc\agg
Nothing shows up in zip dir after kicking off the code above.

Taking the 2 folders and running strongm's code, it works. Here is the zip folder created:

C:\Users\pl04512\Documents\pnc\agg\from CX.zip

thanks.

 

[xwb]

Is there a file called "from CX"?

It is probably called that because you didn't add the .zip at the end of the filename.

Very bad idea to put spaces in filenames. It causes no end of problems. Your 'source dir' is the zipfile. Your zip dir is where all the sources liv.

 

[strongm]

>trying xwb's VBS way of zipping

xwb's code expects a fully qualified filename, not a folder

>strongm's code

To be fair only really the CreateEmptyZip and CopyHere[blah blah].Items remain of my code ...

 

[feipezi]

Hello guys,
Sorry about the late reply.
xwb, 'from CX' is a folder name. The objective is to zip all the files in folder 'from CX' to a folder named 'from CX.zip', which is what I did using strongm's code. I'm trying to do the same thing by VBS alone, using modified xwb's code.

zipfile=inputbox("path/file")
copydir=inputbox("copy dir")


My question is: the zipfile above is like 'from CX.zip', correct? And the 'copydir' like the source folder (from CX) that holds the files before zipping.
Please verify.
thank you all.

 

[strongm]

> I'm trying to do the same thing

Which would be much more something like:

[blue]Option Explicit
Dim pathname
Dim FolderName

pathname=inputbox("enter folder name:") [COLOR=green]' zip file will go in parent of this folder[/color]
FolderName = pathname

CreateEmptyZip pathname & ".zip"

With CreateObject("Shell.Application")
    .Namespace(pathname & ".zip").CopyHere .Namespace(FolderName).items
        Do until .Namespace(pathname & ".zip").Items.Count>0 [COLOR=green]' does not deal well with empty source folder ...[/color]
            wscript.Sleep 1000
        loop
End With

[COLOR=green]' All done![/color]

Public Sub CreateEmptyZip(sPath)
    Dim strZIPHeader
    strZIPHeader = Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
    With CreateObject("Scripting.FileSystemObject")
        .CreateTextFile(sPath).Write strZIPHeader
    End With
End Sub[/blue]