Zip files using Shell Controls 3

[Swi]

I have been using the following code happily for years. (This code was taken from a post that strongm provided)

    CreateEmptyZip OutputFolder & "Backup-" & Format(Date, "YYYYMMDD") & ".zip"
    With CreateObject("Shell.Application")
        .NameSpace(OutputFolder & "Backup-" & Format(Date, "YYYYMMDD") & ".zip").CopyHere .NameSpace(InputFolder).Items
    End With

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

Has anyone else had a problem with running this code on Windows 7?

Thanks.

Swi

 

[strongm]

Works fine under Windows 7 for me ... but it may be related to the folders you are trying to use, since several folders on W7 are not actually folders, just smart placeholders for backwards compatibility with older versions of Windows. What are OutputFolder and InputFolder?

 

[Swi]

Here you go:

    CreateEmptyZip "C:\Backup.zip"
    With CreateObject("Shell.Application")
        .NameSpace("C:\Backup.zip").CopyHere .NameSpace("C:\VBFiles\Test").Items
    End With

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

Swi

 

[strongm]

There you go - by default users are not allowed to create new files in the root of the C drive under Windows 7

 

[Swi]

Perfect. Thank you. I did not know that. I changed it to go to a netword drive and it worked fine.

Now my issue is that I am deleting all files and subfolders after the zip command but it seems to be dropping down to the deletion code before it completes zipping.

Is there some sort of wait argument I can put on the above code to make sure the zip completes before moving on to the deletion code I have after zipping?

Thanks again.

Swi

 

[HughLerwill]

If the files/folders copied coincide exactly with those being deleted have you considered using Movehere in place of Copyhere?

 

[Swi]

HughLerwill,

Yes, that is the case. That worked perfectly.

Thank you for the top. It is much appreciated.

Swi

 

[dilettante]

Have you tested this thoroughly?

I suspect Shell automation will fail for a process with no interactive Desktop available. This can happen in Windows Service programs, components used from IIS pages (server side), and some Windows Scheduler scenarios.

I don't believe this is a general solution, though "good enough" for use in simple desktop applications.

I guess I should actually test it though.

 

[Swi]

Thanks. I will test it more thoroughly.

Swi

 

[dilettante]

I ran this script:

Option Explicit

Private Function ScriptFolder()
    ScriptFolder = InStrRev(WScript.ScriptFullName, "\")
    ScriptFolder = Left(WScript.ScriptFullName, ScriptFolder - 1)
End Function

Private Sub ZipFiles(ByVal ZipFile, ByVal ForceNew, ByVal Files)
    Dim F

    With CreateObject("Scripting.FileSystemObject")
        On Error Resume Next
        With .CreateTextFile(ZipFile, ForceNew, False)
            .Write "PK" & Chr(5) & Chr(6) & String(18, vbNullChar)
            .Close
        End With
        On Error GoTo 0
    End With
    With CreateObject("Shell.Application")
        For Each F In Files
            .NameSpace(ZipFile).CopyHere F
        Next
    End With
End Sub

ZipFiles ScriptFolder() & "\new.zip", _
         True, _
         Array(ScriptFolder() & "\sample.txt")

WScript.Echo "Done!"

Running it with CScript.exe through Task Scheduler as another user (not logged on at all) with SeBatchLogonRight it ran fine.

Just a note: Polsedit can be a handy utility when you're stuck working on one of the Home Editions of Windows (no secpol.msc there).

 

[Swi]

Thanks.

Swi