asked on

VBA routine modification/tweak needed

I had this question after viewing VBA kill active workbook in before close event with condition.

how can i incorporate this peice of code provided by Rgonzo1971 inside my existing Personal.xlsb which has already some codes as the application level events . please see attached my personal workbook.
all i need to add the piece of code below in the workbook close event at application level.

Private Sub App_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    If LCase(Wb.Name) Like "*mercedes*" Then
        strFilename = Wb.FullName
        Application.EnableEvents = False
        Wb.Close False
        Application.EnableEvents = True
        Kill strFilename
    End If
End Sub

Open in new window

PERSONAL.xlsb

Rgonzo1971

Hi,

pls try

Option Explicit
Public WithEvents xlApp As Application
Private Sub Workbook_Open()

 Call InitApp


Set xlApp = Application   ' this is for use of removedocumentinformation

End Sub


Private Sub xlApp_WorkbookBeforeSave(ByVal Wb As Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
  On Error Resume Next
xlApp.ActiveWorkbook.RemoveDocumentInformation (xlRDIAll)
  On Error GoTo 0
 'MsgBox "Removed personal stuff before saving"

End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim fName As String
    If ThisWorkbook.Name = "PERSONAL.xlsb" Then
        If Not SaveAsUI Then
            fName = Application.GetSaveAsFilename(, "Excel Binary Workbook (*.xlsb), *.xlsb")
            If fName = "False" Then
                MsgBox "File NOT saved", vbOKOnly
                Cancel = True
            Else
                Application.EnableEvents = False
                ThisWorkbook.SaveAs Filename:=fName, FileFormat:=xlExcel12
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
    If LCase(Wb.Name) Like "*mercedes*" Then
        strFilename = Wb.FullName
        Application.EnableEvents = False
        Wb.Close False
        Application.EnableEvents = True
        Kill strFilename
    End If
End Sub

Open in new window

in ThisWorksheet module

Regards

Flora Edwards

ASKER

thanks very much Rgonzo1971

i got a small error on strFilename then i added dim strFilename as string and it fixed it.

one last issue when the kill action is performed then even though there isn't any excel file open the application stays open.

recorded my screen attached.
Video---Copy.mp4

ASKER CERTIFIED SOLUTION

Rgonzo1971

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Flora Edwards

ASKER

thanks Rgonzo1971.

the result with the modification code is also the same. application stays open.

Rgonzo1971

then try

Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Dim strFileName
DIm bVisible
    If LCase(Wb.Name) Like "*mercedes*" Then
        strFileName = Wb.FullName
        Application.EnableEvents = False
        Wb.Close False
        Application.EnableEvents = True
        On error resume next
        Kill strFileName
        On error goto 0
        bVisible = False
        For Each wb In Workbooks
            For Each win In wb.Windows
                If win.Visible Then bVisible = True
            Next
        Next
        If Not bVisible Then Application.Quit
    End If
End Sub

Open in new window

Flora Edwards

ASKER

i am sorry, if this is taking too much of your time. it did not work.

i tried alot by myself to figure out what is causing this. i googled and found this article https://excelribbon.tips.net/T011315_Closing_Excel_when_Closing_the_Last_Workbook.html

tried adding Application.SendKeys "+{F4}" line as well. it did not work. somehow after the kill process is done, the personal workbook do not get closed.

Rgonzo1971

One last try

Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Dim strFileName
Dim bVisible
    If LCase(Wb.Name) Like "*mercedes*" Then
        strFileName = Wb.FullName
        Application.EnableEvents = False
        Wb.Close False
        Application.EnableEvents = True
        On Error Resume Next
        Kill strFileName
        On Error GoTo 0
        bVisible = False
        For Each Wb In Workbooks
            For Each win In Wb.Windows
                If win.Visible Then bVisible = True
            Next
        Next
        If Not bVisible Then
            On Error Resume Next
            Application.Workbooks("Personal.xlsb").Close False
            On Error GoTo 0
            Application.Quit
        End If
    End If
End Sub

Open in new window

Professor J

Not trying to hijack Rgonzo's thread, but here is a solution that can work. as i am not doing this for points.

replace.

Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Dim strFileName
DIm bVisible
    If LCase(Wb.Name) Like "*mercedes*" Then
        strFileName = Wb.FullName
        Application.EnableEvents = False
        Wb.Close False
        Application.EnableEvents = True
        On error resume next
        Kill strFileName
        On error goto 0
        bVisible = False
        For Each wb In Workbooks
            For Each win In wb.Windows
                If win.Visible Then bVisible = True
            Next
        Next
        If Not bVisible Then Application.Quit
    End If
End Sub

Open in new window

with this code and it will work.

Private Sub xlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
Dim strFileName
    If LCase(Wb.Name) Like "*mercedes*" Then
        strFileName = Wb.FullName
        Application.EnableEvents = False
        Wb.Close False
        Application.EnableEvents = True
        On Error Resume Next
        Kill strFileName
        On Error GoTo 0
        If Not Me.Windows(1).Visible Then
    If Workbooks.Count <= 1 Then
    xlApp.OnTime Now, ThisWorkbook.CodeName & ".QuitMe"
    End If
    End If
    End If
End Sub
Private Sub QuitMe()
  xlApp.Quit
End Sub

Open in new window

Flora Edwards

ASKER

Thanks.

Professor J

As, i have shown to you in my machine, ID: 42126996 still leaves application open. You probably need to test it with my solution ID: 42127319.
Besides, I suggest you ask a question by opening a question, i do not answer pm.