如何从命令行关闭特定工作簿

Question

我有一个打开 excel 的批处理脚本，一旦打开就会自动触发宏脚本。但是我希望它在宏完成后关闭工作簿：

1. 我尝试在 Excel 中使用 VBA 来关闭自身，但每次它都会打开一个空工作簿。如果它每天运行，它将在那里打开许多空工作簿。

工作簿.关闭

1. 最后在批处理脚本中关闭它。我搜索但没有找到任何有效的方法。 PS 我只想关闭那个工作簿而不是终止 excel 进程。

这是我的 bat 脚本，用于打开工作簿并让它运行

  @echo off
start Excel.exe "I:\SCRIPT\IPCNewScript\ResultNew(DoNotOpen).xlsm"

这是我在打开时调用 main 的 vba 脚本

Sub WorkBook_Open()
Call Sheets("Result").main
ActiveWorkbook.Close SaveChanges:=True
'Application.Quit
End Sub

这是我的主要宏

    Sub main()
Call get_Data_From_DB
Call Reformat
Call Send_Mail
End Sub



Sub get_Data_From_DB()

   Dim cnn As ADODB.Connection
   Dim Names As New Collection
   Set cnn = New ADODB.Connection
   Set ws = ActiveWorkbook.Sheets("Result")
' get sql content

    Dim TextFile As Integer
    Dim FilePath As String
    Dim Sql As String

    'File Path of Text File
    FilePath = "I:\SCRIPT\IPCNewScript\sql.txt"

    'Determine the next file number available for use by the FileOpen function
    TextFile = FreeFile

    'Open the text file
    Open FilePath For Input As TextFile

    'Store file content inside a variable
    Sql = Input(LOF(TextFile), TextFile)


    'Close Text File
    Close TextFile


    ws.UsedRange.Delete

   ' Open a connection by referencing the ODBC driver.


    cnn.ConnectionString = "driver={SQL Server};" & _
       "server=aaaaa,2431;uid=bbbb;pwd=cccc;database=dddd"
    cnn.Open


    i = 1

    ' Find out if the attempt to connect worked.
    If cnn.State = adStateOpen Then
    'Sql = "SELECT top 10 ROW_ID, EMAIL_ADDR from TABLEA(NOLOCK)"
      'Sql = FileContent

      Set rs = cnn.Execute(Sql)

      For FieldNum = 0 To rs.Fields.Count - 1
        ws.Cells(1, i).Value = rs.Fields(FieldNum).Name
        i = i + 1
      Next

      ws.Range("A2").CopyFromRecordset rs
   Else
      MsgBox "Connection Failed"
   End If


   ' Close the connection.
   cnn.Close


End Sub

Sub Reformat()
Dim dt_Str As String, dt As Date
Set ws = ActiveWorkbook.Sheets("Result")


'Work on the first 2 head lines
'set value for the first 2 head lines
ws.Range("A2").EntireRow.Insert

i = 1
'MsgBox i
Do While ws.Cells.Item(1, i) <> ""
'MsgBox i
    If i < 5 Then
        'MsgBox ws.Cells.Item(1, i)
        ws.Cells.Item(2, i).Value = ws.Cells.Item(1, i).Value
        ws.Cells.Item(1, i).Value = ""
    Else
        dt_Str = ws.Cells.Item(1, i)
        'MsgBox i
        dt = DateValue(Left(dt_Str, 4) & "/" & Mid(dt_Str, 5, 2) & "/" & Right(dt_Str, 2))
        ws.Cells.Item(2, i).Value = Left(WeekdayName(Weekday(dt)), 3)
    End If
i = i + 1
Loop


'add color for the first 2 head lines

ws.Range(ws.Cells.Item(1, 5), ws.Cells.Item(1, i - 1)).Interior.Color = RGB(32, 74, 117)
ws.Range(ws.Cells.Item(1, 5), ws.Cells.Item(1, i - 1)).Font.Color = RGB(255, 255, 255)
ws.Range(ws.Cells.Item(1, 5), ws.Cells.Item(1, i - 1)).Font.Bold = True

ws.Range(ws.Cells.Item(2, 1), ws.Cells.Item(2, i - 1)).Interior.Color = RGB(142, 179, 226)
ws.Range(ws.Cells.Item(2, 1), ws.Cells.Item(2, i - 1)).Font.Bold = True

' add color for the call value cells

j = 5
Do While ws.Cells.Item(2, j) <> ""
    i = 3
    Do While ws.Cells.Item(i, j) <> ""
        If ws.Cells.Item(2, j) = "Sun" Then
                ws.Range(ws.Cells.Item(i, j), ws.Cells.Item(i, j)).Interior.Color = RGB(248, 214, 184)
        Else

                If ws.Cells.Item(i, j).Value = 0 Then
                    ws.Range(ws.Cells.Item(i, j), ws.Cells.Item(i, j)).Interior.Color = RGB(254, 200, 205)
                    ws.Range(ws.Cells.Item(i, j), ws.Cells.Item(i, j)).Font.Color = RGB(130, 12, 16)
                End If
        End If
        i = i + 1
    Loop
    j = j + 1
Loop


'Work on the first 4 columns

j = 1
Do While ws.Cells.Item(2, j) <> ""
    i = 3
    Do While ws.Cells.Item(i, j) <> "" And j < 4
        Application.DisplayAlerts = False
        ws.Range(ws.Cells.Item(i, j), ws.Cells.Item(i + 1, j)).Merge
        Application.DisplayAlerts = True
        ws.Range(ws.Cells.Item(i, j), ws.Cells.Item(i + 1, j + 1)).Interior.Color = RGB(217, 217, 217)
        ws.Range(ws.Cells.Item(i, j), ws.Cells.Item(i + 1, j + 1)).Font.Bold = True
        i = i + 2
    Loop
j = j + 1
Loop



'add border
Dim rng As Range

    Set rng = ws.UsedRange

    With rng.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlThin
    End With

ws.Range(ws.Cells.Item(1, 1), ws.Cells.Item(1, 4)).Borders.LineStyle = xlNone
ws.UsedRange.Font.Size = 9
ws.UsedRange.Font.Name = "Calibri"
ws.Columns.HorizontalAlignment = xlCenter
ws.Columns.AutoFit

ActiveWorkbook.SaveCopyAs ("I:\SCRIPT\IPCNewScript\Files\IPCData." & Format(Now(), "yyyymmdd-hh-mm-ss") & ".xlsx")

End Sub


Sub Send_Mail()
'Working in Excel 2002-2016
    Dim Sendrng As Range
    Set ws = ActiveWorkbook.Sheets("Result")

    On Error GoTo StopMacro

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Note: if the selection is one cell it will send the whole worksheet
    Set Sendrng = ws.UsedRange

    'Create the mail and send it
    With Sendrng

        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope

            ' Set the optional introduction field thats adds
            ' some header text to the email body.
            '.Introduction = "All, Please check IPC call data as of today."

            With .Item
                .To = "aaa@aaa.com"
                .CC = "aaa@aaa.com"

                .BCC = ""
                .Subject = "IPC Call Data Report " & Format(Date, "YYYYMMDD")
                .Send
                'MsgBox "sending mail"
                '.Display
            End With

        End With
    End With

StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False

End Sub

Answer 1

如果您已将 Excel 设置为默认启动一个新实例，并且可能即使您没有（我不能 100% 确定 Start 是否会重新使用现有实例，如果可以的话），您可以安全地使用Application.Quit 关闭您正在打开的唯一工作簿。

例如：

Sub WorkBook_Open()
    Sheets("Result").main
    'Don't "close" the workbook, or else it won't be open to run subsequent code
    'ActiveWorkbook.Close SaveChanges:=True
    'Save the workbook instead
    ThisWorkbook.Save
    'And then quit
    Application.Quit
End Sub