none
Closing Excel (Not Workbook) from MS Project Using VBA RRS feed

  • Question

  • Hi All

    I am trying to close Excel if a Worksheet does not exist, however with the code I have it is closing MS Project which I don't want it to do.  My code is enclosed here, any advice would be appreciated:

    Sub TestCopy_SSCL_Plan_Compare_Metrics()
    Dim t As Task
    Dim percentCompleteCt, newtasksCt, removedtaskCt, earlyStartCt, earlyFinishCt, nameCt, durationCt, startCt, finishCt, baseStartCt, baseFinishCt, predCt, succCt, resNameCt As Integer
    Dim xlApp As Excel.Application
    Dim objRange, objRange1, objRange2
    Dim xlRng As Excel.Range
    Dim TkVal
    Dim s As Worksheet
    Dim Row As Integer
    Dim LastRow As Integer
    Dim NextCol As Integer
    Dim xlFilename
    
    Const xlAscending = 1
    Const xlYes = 1
    
    Call KillExcel:
    xlFilename = "D:\CPP Build Template\Plan Comparisons\SSCL Plan Metrics Report.xlsx"
    'Set tsks = ActiveProject.Tasks
    
    'Set Variable values
    removedtaskCt = 0
    nameCt = 0
    durationCt = 0
    percentCompleteCt = 0
    startCt = 0
    finishCt = 0
    baseStartCt = 0
    baseFinishCt = 0
    predCt = 0
    succCt = 0
    resNameCt = 0
    earlyStartCt = 0
    earlyFinishCt = 0
    newtasksCt = 0
    NextCol = 1
    
    For Each t In ActiveProject.Tasks
    Dim Workstream As String
    Workstream = t.Text16
        If (Not t Is Nothing) And (Not t.Summary) Then
    
            'New Tasks added count
            If t.Text30 Like "*- current*" Then
                newtasksCt = newtasksCt + 1
            End If
            'Removed Tasks count
            If t.Text30 Like "*- previous*" Then
                removedtaskCt = removedtaskCt + 1
            End If
            'Change to Name Description
            If t.Text30 Like "Different*" Then
                If t.Text30 Like "Only*" Then
                    nameCt = nameCt + 1
                End If
            End If
            'Change to Durations
            If Not t.Text25 = "Yes" Then
                If t.Text2 <> t.Text1 Then
                    durationCt = durationCt + 1
                End If
            End If
            'Reduction in % complete if task started
            If t.Number3 < 0 Then
                percentCompleteCt = percentCompleteCt + 1
            End If
            'Start Date Slippage
            If t.Text6 Like "-*" Then
                GoTo StartEarly
                Else
                    If t.Text6 <> "" Then
                        If t.Text6 <> "0d" Then
                            startCt = startCt + 1
                        End If
                    End If
            End If
            GoTo Finishcheck
            
    StartEarly:
            'Early Start Date
            earlyStartCt = earlyStartCt + 1
    
    Finishcheck:
            'Finish Date Changes
            If t.Text9 Like "-*" Then
                GoTo FinishEarly
                Else
                If t.Text9 <> "0d" Then
                    If t.Text9 <> "" Then
                        finishCt = finishCt + 1
                    End If
                End If
            End If
            GoTo Basecheck
            
    FinishEarly:
            earlyFinishCt = earlyFinishCt + 1
    
    Basecheck:
            'Baseline Start Changes
            If t.Text9 <> "0d" Then
                baseStartCt = baseStartCt + 1
            End If
            'Baseline Finish Changes
            If t.Text15 <> "" Then
                If t.Text15 <> "0d" Then
                    baseFinishCt = baseFinishCt + 1
                End If
            End If
            'Predecessor Changes
            If Not t.Text30 Like "Current*" Then
                If t.Text25 <> "Yes" Then
                    If t.Text18 = "Different" Then
                        predCt = predCt + 1
                    End If
                End If
            End If
            'Successor Changes
            If t.Text25 <> "Yes" Then
                If t.Text21 = "Different" Then
                    succCt = succCt + 1
                End If
            End If
            'Resource Name Changes
            If t.Text24 <> "Equal" Then
                resNameCt = resNameCt + 1
            End If
        End If
    Next t
    
    'Subtract added tasks count to give correct duration changes figure
    If newtasksCt > durationCt Then
        durationCt = durationCt - newtasksCt
    End If
    
    'Subtract added tasks count to give correct Baseline Start Date changes figure
    If newtasksCt >= baseStartCt Then
        baseStartCt = baseStartCt - newtasksCt
    End If
    
    'Subtract added tasks count to give correct baseline finish date changes figure
    If baseFinishCt > newtasksCt Then
        baseFinishCt = baseFinishCt - newtasksCt
    End If
    
    'Start Excel and create a new Workbook
    On Error GoTo Message
    Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        Workbooks.Open FileName:=xlFilename
        xlApp.Sheets(Workstream).Select
    
    'Find first empty column starting in Row 4
    TkVal = Cells(4, NextCol).Value
    Do Until TkVal = ""
        TkVal = Cells(4, NextCol).Value
        If TkVal <> "" Then
            NextCol = NextCol + 1
        End If
    Loop
    
    xlApp.ActiveSheet.Cells(4, NextCol) = newtasksCt
    xlApp.ActiveSheet.Cells(5, NextCol) = removedtaskCt
    xlApp.ActiveSheet.Cells(6, NextCol) = nameCt
    xlApp.ActiveSheet.Cells(7, NextCol) = durationCt
    xlApp.ActiveSheet.Cells(8, NextCol) = percentCompleteCt
    xlApp.ActiveSheet.Cells(9, NextCol) = startCt
    xlApp.ActiveSheet.Cells(10, NextCol) = finishCt
    xlApp.ActiveSheet.Cells(11, NextCol) = earlyStartCt
    xlApp.ActiveSheet.Cells(12, NextCol) = earlyFinishCt
    xlApp.ActiveSheet.Cells(13, NextCol) = baseStartCt
    xlApp.ActiveSheet.Cells(14, NextCol) = predCt
    xlApp.ActiveSheet.Cells(15, NextCol) = succCt
    xlApp.ActiveSheet.Cells(16, NextCol) = resNameCt
    
    With ActiveWorkbook
        SetAttr xlFilename, vbNormal
    End With
    
    Application.DisplayAlerts = False
    GoTo Finished
    
    Message:
    'Set xlApp = Nothing
    'With xlApp
    '    Application.Quit
    'End With
    GoTo Finished
    Finished:
    'Set xlApp = Nothing
    With xlApp
        ActiveWorkbook.Close
    End With
    MsgBox ("You have tried to open the " & Workstream & " worksheet which does not exist.  This routine will now close.  Please create the Worksheet and run this routine again.")
    Application.DisplayAlerts = True
    End Sub
    Sub KillExcel()
    Dim sKill As String
    
    sKill = "TASKKILL /F /IM msexcel.exe"
    Shell sKill, vbHide
    End Sub
    

    Kind regards

    Tony


    TKHussar

    Tuesday, August 11, 2015 6:58 PM

Answers

  • Hi Tony

    There's a lot of stuff in there, but this is actually you should be working with (from your code):

    Message:
    'Set xlApp = Nothing
    '
    With xlApp
    ' Application.Quit 'End With
    GoTo Finished
    Finished:
    'Set xlApp = Nothing
    With xlApp
        ActiveWorkbook.Close
    End With

    The problem with the above is the order in which things are listed. You can't set the application to Nothing before it's been closed. So:

    xlApp.Quit
    Set xlApp = Nothing

    But before you close Excel you should be doing something with the Workbook? You've gone to all the trouble to write data to it - don't you want to save it? I'm guessing your problem is that Excel is not quitting because of this. Read the Help from the Quit method to understand what's happening if you do not take care of open workbooks that have pending changes:

    "If unsaved workbooks are open when you use this method, Microsoft Excel
    displays a dialog box asking whether you want to save the changes. You can
    prevent this by saving all workbooks before using the Quit method or by
    setting the DisplayAlerts property to
    False. When this property is False, Microsoft Excel doesn’t
    display the dialog box when you quit with unsaved workbooks; it quits without
    saving them.

    If you set the Saved property for a
    workbook to True without saving the workbook to the disk, Microsoft Excel
    will quit without asking you to save the workbook."



    Cindy Meister, VSTO/Word MVP, my blog

    Wednesday, August 12, 2015 1:07 PM
    Moderator
  • Hi Tony,
    >> However I want Excel to be closed completely

    What do you mean by this? Do you mean that you want to close all of the Excel no matter whether it is opened by this code or not? If you want to quit the excel application, you could use Application.Quit.
    A simple code as below:

    Message:
    'Set xlApp = Nothing
    'With xlApp
    '    Application.Quit
    'End With
    GoTo Finished
    Finished:
    'Set xlApp = Nothing
    With xlApp
        'ActiveWorkbook.Close
        .Quit
    End With

    # Application.Quit Method (Excel)
    https://msdn.microsoft.com/en-us/library/office/Ff839269.aspx

    You could not use "Application.Quit", when you use "Application.Quit", this application is MS project application, and it will quit the MS Project application. You need to use xlApp.Quit which will quit excel application.

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.



    Wednesday, August 12, 2015 9:47 AM

All replies

  • Hi Tony,

    >> I am trying to close Excel if a Worksheet does not exist, however with the code I have it is closing MS Project which I don't want it to do.

    What do you mean by “Closing Excel (Not Workbook)”? Do you want to close excel worksheet instead of workbook? What do you mean by “however with the code I have it is closing MS Project”? Do you mean your code close your MS Project instead of excel? I simplify your code and remove the unrelated code with excel, and it worked if you want to close excel workbook. Code as below:

    Sub TestCopy_SSCL_Plan_Compare_Metrics()
    Dim t As Task
    Dim percentCompleteCt, newtasksCt, removedtaskCt, earlyStartCt, earlyFinishCt, nameCt, durationCt, startCt, finishCt, baseStartCt, baseFinishCt, predCt, succCt, resNameCt As Integer
    Dim xlApp As Excel.Application
    Dim objRange, objRange1, objRange2
    Dim xlRng As Excel.Range
    Dim TkVal
    Dim s As Worksheet
    Dim Row As Integer
    Dim LastRow As Integer
    Dim NextCol As Integer
    Dim xlFilename
    
    Const xlAscending = 1
    Const xlYes = 1
    
    Call KillExcel:
    xlFilename = "C:\Users\v-tazho\Desktop\test.xlsx"
    'Set tsks = ActiveProject.Tasks
    
    'Set Variable values
    removedtaskCt = 0
    nameCt = 0
    durationCt = 0
    percentCompleteCt = 0
    startCt = 0
    finishCt = 0
    baseStartCt = 0
    baseFinishCt = 0
    predCt = 0
    succCt = 0
    resNameCt = 0
    earlyStartCt = 0
    earlyFinishCt = 0
    newtasksCt = 0
    NextCol = 1
    
    
    'Start Excel and create a new Workbook
    On Error GoTo Message
    Set xlApp = CreateObject("Excel.Application")
        xlApp.Visible = True
        Workbooks.Open FileName:=xlFilename
        xlApp.Sheets(1).Select
    
    
    Application.DisplayAlerts = False
    GoTo Finished
    
    Message:
    'Set xlApp = Nothing
    'With xlApp
    '    Application.Quit
    'End With
    GoTo Finished
    Finished:
    'Set xlApp = Nothing
    With xlApp
        ActiveWorkbook.Close
    End With
    MsgBox ("You have tried to open the " & Workstream & " worksheet which does not exist.  This routine will now close.  Please create the Worksheet and run this routine again.")
    Application.DisplayAlerts = True
    End Sub
    Sub KillExcel()
    Dim sKill As String
    
    sKill = "TASKKILL /F /IM msexcel.exe"
    Shell sKill, vbHide
    End Sub
    

    If you mean your code close your MS Project, I think it is not related with this code, I suggest you debug your code step by step to check whether code close your MS Project.

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.


    Wednesday, August 12, 2015 6:05 AM
  • Hi Edward

    Many thanks for your help with the revised code.  However I want Excel to be closed completely and the user returned to MS Project so they can see the Message indicating that the worksheet they are trying to update a worksheet that does not exist.

    Kind regards

    Tony


    TKHussar

    Wednesday, August 12, 2015 7:33 AM
  • Hi Tony,
    >> However I want Excel to be closed completely

    What do you mean by this? Do you mean that you want to close all of the Excel no matter whether it is opened by this code or not? If you want to quit the excel application, you could use Application.Quit.
    A simple code as below:

    Message:
    'Set xlApp = Nothing
    'With xlApp
    '    Application.Quit
    'End With
    GoTo Finished
    Finished:
    'Set xlApp = Nothing
    With xlApp
        'ActiveWorkbook.Close
        .Quit
    End With

    # Application.Quit Method (Excel)
    https://msdn.microsoft.com/en-us/library/office/Ff839269.aspx

    You could not use "Application.Quit", when you use "Application.Quit", this application is MS project application, and it will quit the MS Project application. You need to use xlApp.Quit which will quit excel application.

    Best Regards,

    Edward


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.



    Wednesday, August 12, 2015 9:47 AM
  • Hi Tony

    There's a lot of stuff in there, but this is actually you should be working with (from your code):

    Message:
    'Set xlApp = Nothing
    '
    With xlApp
    ' Application.Quit 'End With
    GoTo Finished
    Finished:
    'Set xlApp = Nothing
    With xlApp
        ActiveWorkbook.Close
    End With

    The problem with the above is the order in which things are listed. You can't set the application to Nothing before it's been closed. So:

    xlApp.Quit
    Set xlApp = Nothing

    But before you close Excel you should be doing something with the Workbook? You've gone to all the trouble to write data to it - don't you want to save it? I'm guessing your problem is that Excel is not quitting because of this. Read the Help from the Quit method to understand what's happening if you do not take care of open workbooks that have pending changes:

    "If unsaved workbooks are open when you use this method, Microsoft Excel
    displays a dialog box asking whether you want to save the changes. You can
    prevent this by saving all workbooks before using the Quit method or by
    setting the DisplayAlerts property to
    False. When this property is False, Microsoft Excel doesn’t
    display the dialog box when you quit with unsaved workbooks; it quits without
    saving them.

    If you set the Saved property for a
    workbook to True without saving the workbook to the disk, Microsoft Excel
    will quit without asking you to save the workbook."



    Cindy Meister, VSTO/Word MVP, my blog

    Wednesday, August 12, 2015 1:07 PM
    Moderator