Runtime error 76: Path not found....Zip files in folder...

[pedie]

Hi, I'm getting this error message from the following code from this link.
Can someone please help.

Thanks in advance.
PS: If possible i want the files in all the subfolders of this path be zipped together.
The path i have right now is correct but still says not found....

[/FONT]
[FONT=Courier New]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[/FONT]

[FONT=Courier New]Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
    On Error Resume Next
    bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function[/FONT]

[FONT=Courier New]Function Split97(sStr As Variant, sdelim As String) As Variant
'Tom Ogilvy
    Split97 = Evaluate("{""" & _
                       Application.Substitute(sStr, sdelim, """,""") & """}")
End Function
Sub Zip_All_Files_in_Folder()
    Dim FileNameZip, FolderName
    Dim strDate As String, DefPath As String
    Dim oApp As Object[/FONT]
[FONT=Courier New]    DefPath = Application.DefaultFilePath
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If[/FONT]
[FONT=Courier New]    FolderName = "C:\Users\Pedie\Desktop\VBA inputbox\"    '<< Change[/FONT]
[FONT=Courier New]    strDate = Format(Now, " dd-mmm-yy h-mm-ss")
    FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"[/FONT]
[FONT=Courier New]    'Create empty Zip File
    NewZip (FileNameZip)[/FONT]
[FONT=Courier New]    Set oApp = CreateObject("Shell.Application")
    'Copy the files to the compressed folder
    oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items[/FONT]
[FONT=Courier New]    '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 find the zipfile here: " & FileNameZip
End Sub

 

[poolhall]

works perfectly fine for me.

 

[pedie]

Do you think this is because of my window? I have win_Vista.

Normally/manually there is no way i can zip the file that is why i want vba to do it.


Please recheck for me

 

[poolhall]

on which line of this code exactly are you getting this error?

 

[pedie]

On 4th line of the function..

"Open sPath For Output As #1"

 

[poolhall]

try to change

DefPath = Application.DefaultFilePath

to

DefPath = "C:\Users\Pedie\Desktop\"

and see if it makes a difference.

 

[meldoc]

Hi Pedie

The code works for me as is, I tested it on my old Vista/ Xl07 setup.

 

[Norie]

pedie

Are you sure you can't manually create zip/compressed files in Vista?

http://windows.microsoft.com/en-US/windows-vista/Compress-and-uncompress-files-zip-files

 

[meldoc]

Hello again Pedie

See if posts #7,#8 and #9, in the below link help.

http://www.techimo.com/forum/general-tech-discussion/192604-cant-open-zip-files-vista.html

 

[pedie]

Hi everyone thanks a lot for helping me out.
I think it is my system and not win vista...it does not allow me to manually zip files..

But with the modification done to the code it is working great...!

I event tried posting reply to this thread but error keeps happening may be because of the traffic in this forum :D

Thanks again everyone!