从Vba代码执行命令行命令 [英] Execute Command Line Command from Vba Code

问题描述

    

您好，

    

Hello,

我正在尝试压缩我刚刚在用户桌面上创建的文件夹。要做到这一点，我试图使用7zip命令行命令。我可以为我尝试
执行的命令创建字符串，但我不知道如何执行它。任何帮助将不胜感激。谢谢！这是我的代码

I am trying to compress a folder i have just created on the users desktop. to do this i am trying to use the 7zip command line commands. I can create the string for the command i am trying to execute, but i don't know how to execute it. Any help would be greatly appreciated. Thanks! Here is my code

Private Sub ExportBtn_Click(sender As System.Object, e As System.EventArgs) Handles ExportBtn.Click

        If Me.RFQDataSet.HlpRFQByProgram.Rows.Count > 0 Then

            Dim HeadSel As Integer, ItemSel As String, MaxInd As Integer, IndSel As Integer, SaveDir As String
            MaxInd = Me.RFQDataSet.HlpRFQByProgram.Rows.Count - 1
            IndSel = 0
            SaveDir = Environment.GetFolderPath(Environment.SpecialFolder.DesktopDirectory) & "\" & Me.ProgSelCmb.Text & " RFQ's" & " " & Replace(Replace(CStr(Now()), "/", "_"), ":", "_")
            MkDir(SaveDir)

            Do Until IndSel > MaxInd

                HeadSel = Me.RFQExpDGV.Rows(IndSel).Cells(2).Value
                ItemSel = Me.RFQExpDGV.Rows(IndSel).Cells(3).Value
                Export(ItemSel, HeadSel, SaveDir)
                IndSel = IndSel + 1

            Loop

            Dim CmdPromt As String
            CmdPromt = "C:\""Program Files""\7-Zip\7z a -tzip " & SaveDir & ".zip " & SaveDir * "\*"
            '------> Here is Where i would Compress The Folder<--------------

        End If

    End Sub

    Sub Export(ItemSel As String, HeadSel As Integer, SaveDir As String)
        '
        Dim LWordDoc As String
        Dim oApp As Object
        Dim wb As Object
        '
        'Path to the Excel document
        LWordDoc = "\\gsifiles\hcommon\Merch Planning\Database\Cross Company\Import - Export\RFQ\RFQ Template.xlsm"
        '
        If Dir(LWordDoc) = "" Then
            MsgBox("Document not found.")
            '
        Else
            'Create an instance of MS Excel
            oApp = CreateObject("Excel.Application")
            oApp.DisplayAlerts = False

            'Open the Document
            wb = oApp.Workbooks.Open(LWordDoc)
            oApp.Visible = True

            wb.SaveAs("\\gsifiles\hcommon\Merch Planning\Database\Cross Company\Documents\RFQ\" & ItemSel & " " & Environment.UserName & " " & Replace(Replace(CStr(Now()), "/", "_"), ":", "_") & ".xlsm")
            '
            oApp.Sheets("Request For Quotation").Unprotect(Password:="gartner123")
            oApp.Sheets("Sheet1").Unprotect(Password:="gartner123")
            '
            oApp.Sheets("Sheet1").Select()
            oApp.Range("A1").Select()
            oApp.ActiveCell.FormulaR1C1 = HeadSel
            oApp.Range("B1").Select()
            oApp.Run("CreateRFQ")
            oApp.Run("CleanUp")
            '
            wb.Save()
            wb.SaveAs(SaveDir & "\RFQ For " & ItemSel & " " & Replace(Replace(CStr(Now()), "/", "_"), ":", "_") & ".xlsm")
            wb.close()
            oApp.close()
            '
            oApp.DisplayAlerts = True
            wb = Nothing
            oApp = Nothing
            '
        End If

    End Sub

推荐答案

嗨Josh，

请试试这个：

Shell CmdPromt, vbNormalFocus

这篇关于从Vba代码执行命令行命令的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！