Zip File Path in Worksheet

rudevincy

Active Member
Joined
Feb 21, 2005
Messages
417
I am trying to create a zip file for a few excel files. In my excel worksheet I have the name of the files that I want to zip.... I found a code from Ron de Bruin and in looking online I tried to remove the

FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
MultiSelect:=True, Title:="Select the files you want to zip")

and replace it with

strFiles = Worksheets("ServiceZip").Range("J1").Value
FName = Array(strFiles)

In the ServiceZip sheet cell J1 is a formula that groups the name of the files together and it shows the information like "C:\Users\Me\Documents\Reports\61028_201601.xls", "C:\Users\Me\Documents\Reports\11001_201601.xls", "C:\Users\Me\Documents\Reports\21029_201601.xls", "C:\Users\Me\Documents\Reports\31003_201601.xls", "C:\Users\Me\Documents\Reports\32020_201601.xls", "C:\Users\Me\Documents\Reports\41001_201601.xls", "C:\Users\Me\Documents\Reports\42074_201601.xls", "C:\Users\Me\Documents\Reports\51012_201601.xls")


It does not seem to be working can someone please help me...

Here is the code I got from Ron de Bruin:

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


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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
and replace it with

strFiles = Worksheets("ServiceZip").Range("J1").Value
FName = Array(strFiles)

instead use

Code:
FName = Split(ServiceZip.Range("J1").Value, ",")
 
Upvote 0
rudevincy I hope that you understand that saying "I cant get this to work" is not getting us anywhere. Please tell where you have problems. What is it that you do not understand or cannot do?
Then we can get the job done.
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,949
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top