Running 7Z in a dos command from VBA Excel causes warning alert

Question

I am currently using the following code to run a dos command as follows from VBA.

Set objShell = CreateObject("WScript.Shell")

dos_command="\\\10.xx.xx.xx\test\7z.exe  a -r " etc etc etc

result = objShell.Run(dos_command, 0, True)

Set objShell =nothing

All runs well, the only problem is that I get an annoying Warning Windows Box advising a program is trying to run in my computer, press OK or Cancel

I must use "objshell" because I need VBA to wait until DOS command is completed.

is there a way to avoid the warning box from coming up from within VBA or adding some additional parameters to the DOS command ?

The 7z.exe file is running in a server (not local PC) so I assume that's the problem.

I cannot use or install 7z.exe in each machine.

Answer 1

Here are three options, presented in order from quickest/dirtiest to most robust:

1. Create a text file as part of command line and wait for its existence: modify your command line to something like this and run it using Shell (not your objShell):

   dos_command = "\\\10.xx.xx.xx\test\7z.exe  a -r " etc etc etc
   dos_command = dos_command & " && echo > " & TempFileName
   

   This will create a text file named TempFileName after your 7-zip code completes. You just need to make sure TempFileName does not exist before you run your shell command, then run the command and wait for the TempFileName file to exist.

2. Use OpenProcess and GetExitCodeProcess APIs: launch your command line using the OpenProcess API call which provides access to your new process (note that the Shell function returns the ProcessID of the launched process). Then use the ProcessID to sit in a loop and poll the process via GetExitCodeProcess. Relevant declarations:

   Private Declare Function OpenProcess Lib "kernel32" _
           (ByVal dwDesiredAccess As Long, _
            ByVal bInheritHandle As Long, _
            ByVal dwProcessId As Long) As Long
   Private Declare Function GetExitCodeProcess Lib "kernel32" _
           (ByVal hProcess As Long, _
            lpExitCode As Long) As Long
   Private Const STILL_ACTIVE = &H103
   Private Const PROCESS_QUERY_INFORMATION = &H400
   
   '---------------------------------------------------------------------------------------vv
   ' Procedure : ShellWait
   ' DateTime  : 2/15/2008 10:59
   ' Author    : Mike
   ' Purpose   : Executes a shell command and waits for it to complete.
   ' Notes     : Runs the shell as a batch file, allowing the user to pass a string with
   '             line breaks to execute a multi-line command.
   '
   '           : Provides two means to break out of the loop.
   '             1) Provide a timeout in seconds.
   '                The code breaks out once it reaches the timeout.
   '             2) Provide a flag to tell the procedure to stop running.
   '                To use this option, you would need to pass the procedure a global flag
   '                that the user has the ability to change through the interface.
   ' Update (5/23/2008):
   '           - Uses a progressive sleep timer to allow fast processes to run quickly
   '               and long processes to get increasing clock cycles to work with.
   '           - Changed default window mode to hidden.
   '---------------------------------------------------------------------------------------
   '^^
   Public Function ShellWait(DosCmd As String, _
                             Optional StartIn As String = "WINDOWS TEMP FOLDER", _
                             Optional WindowStyle As VbAppWinStyle = vbHide, _
                             Optional TimeOutSeconds As Long = -1, _
                             Optional ByRef StopWaiting As Boolean = False)    'vv
       On Error GoTo Err_ShellWait
   
       Dim hProcess As Long, RetVal As Long, StartTime As Long
       Dim BatName As String, FileNum As Integer, SleepTime As Long
   
       StartTime = Timer
   
       BatName = TempFileName(StartIn, "bat")
       FileNum = FreeFile()
       Open BatName For Output As #FileNum
       ChDrive Left(BatName, 1)
       ChDir Left(BatName, InStrRev(BatName, "\"))
       Print #FileNum, DosCmd
       Close #FileNum
   
       hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(BatName, WindowStyle))
       SleepTime = 10
       Do
           'Get the status of the process
           GetExitCodeProcess hProcess, RetVal
           DoEvents: Sleep SleepTime
           If TimeOutSeconds <> -1 Then
               If Timer - StartTime > TimeOutSeconds Then Exit Do
           End If
           If StopWaiting Then Exit Do
           'Progressively increase the SleepTime by 10%
           '  This allows a quick process to finish quickly, while providing
           '  a long process with increasingly greater clock cycles to work with
           SleepTime = SleepTime * 1.1
       Loop While RetVal = STILL_ACTIVE
       Kill BatName
   
   Exit_ShellWait:
       Exit Function
   Err_ShellWait:
       MsgBox Err.Description
       Resume Exit_ShellWait
   End Function
   
   '---------------------------------------------------------------------------------------vv
   ' Procedure : TempFileName
   ' DateTime  : 12/9/08
   ' Author    : Mike
   ' Purpose   : Returns an unused file name but does not create the file.  Path can be
   '             passed with or without the trailing '\'.
   ' Requires  : TempPath() function
   '---------------------------------------------------------------------------------------
   '^^
   Function TempFileName(Optional ByVal Path As String = "WINDOWS TEMP FOLDER", _
                         Optional Ext As String = "txt", _
                         Optional Prefix As String = "temp") As String    'vv
   Dim TempFName As String, i As Integer
   
       If Path = "WINDOWS TEMP FOLDER" Then Path = TempPath
       If Right(Path, 1) <> "\" Then Path = Path & "\"
       If Not (Path Like "?:\*" Or Path Like "\\*") Then
           Err.Raise 52    '"Bad file name or number."
       ElseIf Dir(Path, vbDirectory) = "" Then
           Err.Raise 76    '"Path not found."
       End If
   
       TempFName = Path & Prefix & "." & Ext
       For i = 1 To 500
           If Dir(TempFName) = "" Then
               TempFileName = TempFName
               GoTo Exit_TempFileName
           End If
           TempFName = Path & Prefix & "_" & Format(i, "000") & "." & Ext
       Next i
       TempFileName = ""
   
   End Function
   
   '---------------------------------------------------------------------------------------
   ' Procedure : TempPath
   ' Author    : Mike
   ' Date      : 8/12/2008
   ' Purpose   : Returns something like:
   '               C:\DOCUME~1\BGRAND~1\LOCALS~1\Temp\
   '---------------------------------------------------------------------------------------
   '^^
   Function TempPath() As String    'vv
   Const TemporaryFolder = 2
   Static TempFolderPath As String
   Dim fs As Object
       If Len(TempFolderPath) = 0 Then
           Set fs = CreateObject("Scripting.FileSystemObject")
           TempFolderPath = fs.GetSpecialFolder(TemporaryFolder) & "\"
       End If
       TempPath = TempFolderPath
   End Function
   

3. Use CreateProcess and WaitForSingleObject APIs: refer to the "Super Shell" example at this help page for CreateProcess

Answer 2

Calling Microsoft® Windows® Script Host causes windows to display the message. Instead try this

Public Sub test()
   Dim dos_command$, lRet&
   dos_command = """\\xxx.xxx.xxx.xxx\xxx\xxx\7z.exe"" a test.zip ""\\xxx.xxx.xxx.xxx\xxx\xxx\*.log"" -r"
   lRet = Shell(dos_command, vbMaximizedFocus)
   MsgBox lRet
End Sub

UPDATE

You may do the following and use your code:

• Open Start | Run and type gpedit.msc. Click OK
• User Configuration >> Administrative Templates >> Windows Components >> Attachment Manager
• Add 7z.exe to the Inclusion list for moderate risk file types setting.

---

Hpe this helps