Calling 7-Zip from VBA

[Graham Allen]

Hi,

Does anyone have some example code of calling 7-Zip from VBA?

I have code that uses SHELL but would like to call 7-Zip directly if possible.

I just want to zip a single file (with password if possible) into a newly created ZIP (or 7Z) file without the user seeing anything (if possible).

Thanks

[RobCr]

I too would like similar for VB6
If no one responds, I would apprciate seeing your Shell code.
Thanks,
Rob

[Graham Allen]

My SHELL code - a bit rough in places!

Option Explicit

Private Declare Function OpenProcess Lib "kernel32" (ByVal _
       dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
       ByVal dwProcessId As Long) As Long

Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, _
   lpExitCode As Long) As Long
  
Private Declare Sub sapiSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
  
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const STILL_ACTIVE = &H103

Const s7zipPrg As String = "c:\Program Files\7-Zip\7z"

Public Function MBS_ZipFile(sfile As String, szip As String, Optional spass As String = "") As Boolean

    Dim bsuccess As Boolean
    bsuccess = True

    Dim scmd As String
   
    If spass <> "" Then
        scmd = s7zipPrg & " a -t7z -y " & szip & " " & sfile & " -p" & spass
    Else
        scmd = s7zipPrg & " a -tzip -y " & szip & " " & sfile
'        scmd = s7zipPrg & " a -t7z -y " & szip & " " & sfile
    End If

    Dim retval
    retval = Shell(scmd, vbHide)

    ''' Get the process handle from the task ID returned by Shell.
    Dim lProcess, lExitCode, lResult
    lProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0&, retval)

    ''' Check for errors.
    If lProcess <> 0 Then
        ''' Loop while the shelled process is still running.
        Do
            ''' lExitCode will be set to STILL_ACTIVE as long as the shelled process is running.
            lResult = GetExitCodeProcess(lProcess, lExitCode)
            DoEvents
            Call sapiSleep(100)
        Loop While lExitCode = STILL_ACTIVE
    End If

    If Trim(Dir(szip)) = "" Then
        bsuccess = False
    End If
   
    MBS_ZipFile = bsuccess

End Function

Sub test()
    Call MBS_ZipFile("D:\junk.doc", "d:\Test1.7z")
End Sub

[RobCr]

Thank you for sharing.
I have been using VB6(& prior) for 10 years.
Also have done a little Excel automation from VB.
Anything I can share in return ?
Rob