3

我目前正在使用以下代码dosVBA.

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

一切运行良好,唯一的问题是我收到一个烦人的警告 Windows 框,建议程序试图在我的计算机上运行,​​按 OK 或 Cancel

我必须使用"objshell",因为我需要VBA等到DOS命令完成。

有没有办法避免警告框从 VBA 中出现或向 DOS 命令添加一些附加参数?

7z.exe 文件在服务器(不是本地 PC)中运行,所以我认为这就是问题所在。

我无法在每台机器上使用或安装 7z.exe。

4

2 回答 2

2

以下是三个选项,按从最快/最脏到最强大的顺序排列:

  1. 创建一个文本文件作为命令行的一部分并等待它的存在:将您的命令行修改为类似的内容并使用Shell(不是您的objShell)运行它:

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

    这将创建一个以您的 7-zip 编码完成TempFileName 命名的文本文件。您只需要在运行 shell 命令之前确保TempFileName不存在,然后运行命令并等待TempFileName文件存在。

  2. 使用OpenProcessGetExitCodeProcessAPI :使用OpenProcess API 调用启动命令行,该调用提供对新进程的访问(请注意,该Shell函数返回已启动进程的 ProcessID)。然后使用 ProcessID 进入循环并通过GetExitCodeProcess轮询进程。相关声明:

    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. 使用 CreateProcess 和 WaitForSingleObject API :请参阅CreateProcess帮助页面上的“Super Shell”示例

于 2012-07-06T14:03:27.190 回答
1

调用Microsoft® Windows® Script Host会导致窗口显示消息。而是试试这个

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

更新

您可以执行以下操作并使用您的代码:

  • 打开开始 | 运行并输入gpedit.msc. 点击确定
  • 用户配置 >> 管理模板 >> Windows 组件 >> 附件管理器
  • 将 7z.exe 添加到中度风险文件类型设置的包含列表中。

希望这有帮助

于 2012-07-06T10:12:49.870 回答