How to close a specific workbook from command line

1
votes

i have a batch script that open an excel, and automatically trigger the macro script once open. However i want it to close the workbook once macro done:

  1. i tried to use VBA in excel to close itself, but every time it will leave an empty workbook open. if it runs daily it will have lots of empty workbook open there.

Workbook.Close

  1. close it within the batch script at the end. I searched but didnt find any that works. PS i only want to close that single workbook instead of kill the excel process.

Here is my bat script to open the workbook and let it run

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

Here is my vba script of calling main upon open

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

Here is my main macro 

    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 = "[email protected]"
                .CC = "[email protected]"

                .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
1
excelvba
You probably just need to add Application.Quit to your macro. – YowE3K
@YowE3K doesnt seem to work. Those empty workbooks are still open. Here is what i have now: Sub WorkBook_Open() Call Sheets("Result").main ActiveWorkbook.Close SaveChanges:=True Application.Quit End Sub – ella
Is it a batch file you are running, or is it something like VBScript? Are you opening the workbook in an existing instance of Excel, or in a new instance, or are you letting the o/s open it however it likes? What are you doing in main (e.g. does it change the active workbook at all)? It would be so much easier to assist if you included code in the question so that we could see what you are doing, rather than guess how you might be doing it based on a description. – YowE3K
Actually, I just read the very last part of your question - "PS i only want to close that single workbook instead of kill the excel process" - so Application.Quit won't be of any use because it will close all workbooks that are open in that instance of Excel. – YowE3K
(And, FWIW, luckily the Application.Quit was never being executed in the code you used because you closed the workbook containing the code before it got to that statement. If it had reached that Quit statement it would have closed all workbooks in that instance.) – YowE3K

1 Answers

0
votes

Providing you have Excel set up to start a new instance by default, and possibly even if you don't (I'm not 100% sure whether Start will re-use an existing instance if it can), you can safely use Application.Quit to close down the sole workbook you are opening.

E.g.:

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