Well...I'm trying one more thing to completely automate the process. I have
created a 2nd workbook that is called from the 1st workbook that I ultimately
want to zip. I write the variables I need to sheet1 and then reload those
variables when the zip macro is run. I've modified your code to use the path
and zip file name I want, but the one thing I can't make it do is
automatically use the filename (SName) when it gets to the part where you
open the file to zip. It looks like the code won't support inserting the
filename like the SaveAsFile will. Could you look at this and let me know?
Here is the code in the zip.xls worksheet:
Dim strDate As String, DefPath As String, sFName As String
Dim oApp As Object, iCtr As Long
Dim FName, vArr, FileNameZip
Dim ZName As String
Dim SName As String
Dim File_path As String
Worksheets(1).Select
ZName = Range("A1").Value 'contains the zip file name I want
SName = Range("A2").Value 'contains the file name I want to zip
File_path = Range("A3").Value 'contains the path of the both the file I
want to zip and the target of the zip file I want to create.
'Original Code Goes to My Documents
'DefPath = Application.DefaultFilePath
'Sets path to where my files are located
DefPath = File_path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Original Code to Set the Zip File Name
'strDate = Format(Now, " dd-mmm-yy h-mm-ss")
'FileNameZip = File_path & "MyFilesZip " & strDate & ".zip"
'I want to use my own zip name
FileNameZip = DefPath & ZName
'Browse to the file(s), use the Ctrl key to select more files
'Original Code to set which file to zip
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls),
*.xls", _
MultiSelect:=True, Title:="Select
the files you want to zip")
(THIS IS WHERE I'M TRYING TO USE THE SNAME)
'I want automatically use my own filename
FName = Application.GetOpenFilename(SName)
If IsArray(FName) = False Then
'do nothing
Else
'Create empty Zip File
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
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: " & FName(iCtr)
Else
'Copy the file to the compressed folder
oApp.Namespace(FileNameZip).CopyHere (FName(iCtr))
End If
Next iCtr
MsgBox "You will find your zipfile here: " & FileNameZip
Set oApp = Nothing
End If
End Sub
Sub NewZip(sPath)
'Create empty Zip File
'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
