macro sequencing - allow user to enable macros prior to sheet deletion

[Phuels]

HI all,

I'm using a macro to create two published versions of a workbook. The workbook I use has a SAS add-in reference that my customers do not have. To prevent them from receiving reference library errors, I publish the workbooks for their use without macros. Since I'm using a macro to publish the workbook, I create a duplicate copy (SaveCopyAs) then open and modify the duplicate.

Because the duplicate copy is initially a macro-enabled workbook, there's a prompt to enable macros. The problem I run into is that the enable macros prompt shows up in the ribbon unless I have VBA editor open. If VBA editor is open, I get a pop-up which allows me to enable the macros in the duplicate workbook. If VBA editor is not open, I can't enable the macros and the code stops.

I don't want to disable the user's automation security via VBA, and am hoping it is just a matter of code sequencing in order to allow the user to enable macros when the VBA editor is not open.

Here's my code; any suggestions are greatly appreciated.

Sub Publish_Report()

Dim strDir As String
Dim strTempSave As String
Dim strFolder As String
Dim strDataDate As String
Dim strFolderDate As String
Dim dtMax As Date
Dim oSheet As Worksheet
Dim bkNew As Workbook
Dim strSecurity As String

strDir = "file path name"

dtMax = ThisWorkbook.Sheets("Injury").Range("R6").Value
strDataDate = Format(dtMax, "yyyy-mm")
strFolderDate = Format(Application.WorksheetFunction.EoMonth(dtMax, 1), "yyyy-mm")
strTempSave = "C:\Users\" & Environ("UserName") & "\Documents\PFR_Temp.xlsm"

strFolder = Dir(strDir & "PD Discussion Documents\" & strFolderDate, vbDirectory)
If strFolder = "" Then MkDir (strDir & "PD Discussion Documents\" & strFolderDate)

If MsgBox("Saving the document, saving to the 5Q folder, and saving to the Discussion Documents folder.", vbOKCancel) = vbOK Then

    ThisWorkbook.Save
    
    ' Save a temporary copy to allow saving as a non-macro enabled workbook
    ThisWorkbook.SaveCopyAs strTempSave
    
    ' Open the temporary copy. 
    Workbooks.Open strTempSave
   
    Set bkNew = ActiveWorkbook
    
    With bkNew
        
        ' Create and save managers copy
        .Sheets(Array("VPO_5Q", "Track_Record", "Notes")).Delete
    
        .Application.DisplayFormulaBar = False
        
        For Each oSheet In .Sheets
            Select Case oSheet.Name
            Case Is = "Source", "Casualty", "Injury", "Injury_CM_5Q"
                oSheet.Activate
                oSheet.Range("A7").Activate
                ActiveWindow.DisplayHeadings = False
                ActiveWindow.DisplayGridlines = False
                oSheet.Protect DrawingObjects:=False, AllowFiltering:=True
                
            Case Else
                oSheet.Visible = xlSheetHidden
            End Select
        Next oSheet
               
        UpdateSlicer sCache:=.SlicerCaches("Slicer_View"), strCompare:="All DP & VPO", bShow:=True
        .SaveAs _
            Filename:=strDir & "CM 5Q Folder\PFR Metrics.xlsx", _
            FileFormat:=51, _
            ConflictResolution:=xlLocalSessionChanges
        
        ' create and save OVP copy
        .Sheets("Injury_CM_5Q").Delete
        
        UpdateSlicer sCache:=.SlicerCaches("Slicer_View"), strCompare:="All VPO Only", bShow:=True
        .SaveAs _
            Filename:=strDir & "PD Discussion Documents\" & strFolderDate & "\" & strDataDate & " PFR Metrics.xlsx", _
            FileFormat:=51, _
            ConflictResolution:=xlLocalSessionChanges
        .Close
                
        On Error GoTo ErrorMsg
    
    End With
    
    ' delete the temporary workbook
    Kill strTempSave
    
End If
       
Application.DisplayAlerts = True
        
Exit Sub
       
ErrorMsg:
    MsgBox "Not able to save to the PD Discussion Document folder!"

End Sub

 

[Jeffrey Mahoney]

I have never been able to solve this. We don't have access to change the Macro permissions using VBA, otherwise a virus could just push its way through.

I have created a splash screen that tells the user they have to enable macros before continuing. That get's old over time. A 3 second timer could move past the splash screen. More of my troubleshooting comes from people that don't see the Macro warning below the ribbon.

 

[rlv01]

Something does not make sense to me. If the intent it is to strip the macros from the workbook before giving it to your user, why would the user need to enable macros at all? It seems like any automation security issue would be on your PC , not your user's.

 

[GWteB]

Something does not make sense to me. If the intent it is to strip the macros from the workbook before giving it to your user, why would the user need to enable macros at all? It seems like any automation security issue would be on your PC , not your user's.

I (partly) agree with this. After all, the OP's customers are not confronted with this behavior since there are no macros. Partly, because Excel doesn't yet consider any macro enabled workbook saved in ANOTHER folder through SaveAs as a trusted workbook (at least with my current settings in Trust Center). The workbook must first be opened again, after which macros (yellow bar) must be allowed manually. Once this is done, it becomes a trusted file.
A solution for the OP would be to immediately save the temporary file as an .xlsx (without macros), then reopen it and erase worksheets, save again, and so on.

 

[rlv01]

...Partly, because Excel doesn't yet consider any macro enabled workbook saved in ANOTHER folder through SaveAs as a trusted workbook (at least with my current settings in Trust Center).

Which raises the question of why save the temp file in another folder? It's a temp file so save it in the same folder.

Sub StripMacros()
    Dim MacroWB As Workbook, MacroWBCopy As Workbook
    Dim TmpFile As String, NoMacros As String

    Set MacroWB = ThisWorkbook

    With MacroWB
        TmpFile = .Path & "\TempFile.xlsm"
        NoMacros = Left(.Name, InStr(.Name, ".") - 1) & "_NoMacros.xlsx"
    End With

    MacroWB.SaveCopyAs Filename:=TmpFile              'save copy w/macros

    Set MacroWBCopy = Workbooks.Open(Filename:=TmpFile)    'open copy
    With MacroWBCopy
        Application.DisplayAlerts = False
        .SaveAs Filename:=MacroWB.Path & "\" & NoMacros, FileFormat:=51    'save macro-free version
        Application.DisplayAlerts = True
        .Close False
    End With
    VBA.Kill TmpFile                                  'delete copy w/macros
    MsgBox "New macro-free file:" & vbCr & vbCr & NoMacros, vbOKOnly Or vbInformation, Application.Name
End Sub

 

[GWteB]

Which raises the question of why save the temp file in another folder? It's a temp file so save it in the same folder.

A solution would be to immediately save the temporary file as an .xlsx. Since the modified files are also without macros, a temporary file can be omitted.
A note I have to make here is that there's almost always a distinction between a file on disk and a file read into the computer's memory. When writing the modified versions of the workbook without macros, the contents of the memory remain intact until the workbook in which the current macro runs is closed, even if its filename on disk (and on the title bar of Excel's main window) ends with .xlsx. VBE also gets confused by this and sometimes shows workbooks in the Project Explorer that are not there (anymore). Just switching to Excel's main window and back to VBE causes the Project Explorer pane to be updated.

For completeness regarding the OP's request:

Sub Publish_Report_r2()

    Dim strDir          As String
    Dim strFolder       As String
    Dim strDataDate     As String
    Dim strFolderDate   As String
    Dim dtMax           As Date
    Dim oSheet          As Worksheet
    Dim bkNew           As Workbook
    Dim strSecurity     As String
   
' == end up with original file on desktop ==
    Dim sMasterCopyFullName  As String
    sMasterCopyFullName = ThisWorkbook.FullName
   
    strDir = "file path name"
   
    dtMax = ThisWorkbook.Sheets("Injury").Range("R6").Value
    strDataDate = Format(dtMax, "yyyy-mm")
    strFolderDate = Format(Application.WorksheetFunction.EoMonth(dtMax, 1), "yyyy-mm")
  
    strFolder = Dir(strDir & "PD Discussion Documents\" & strFolderDate, vbDirectory)
    If strFolder = "" Then MkDir (strDir & "PD Discussion Documents\" & strFolderDate)
   
    If MsgBox("Saving the document, saving to the 5Q folder, and saving to the Discussion Documents folder.", vbOKCancel) = vbOK Then
   
        ThisWorkbook.Save
       
' ============ temporary copy no longer needed ==================

        With ThisWorkbook
           
            ' Save managers copy and modify accordingly
           
' ==== on disk macros are removed from the workbook, this running ====
' ==== macro however stays within memory and will proceed (!!) =======

            Application.DisplayAlerts = False
            .SaveAs Filename:=strDir & "CM 5Q Folder\PFR Metrics.xlsx", _
                    FileFormat:=xlOpenXMLWorkbook, _
                    ConflictResolution:=xlLocalSessionChanges
           
            .Sheets(Array("VPO_5Q", "Track_Record", "Notes")).Delete
            .Application.DisplayFormulaBar = False
           
            For Each oSheet In .Sheets
                Select Case oSheet.Name
                Case Is = "Source", "Casualty", "Injury", "Injury_CM_5Q"
                    oSheet.Activate
                    oSheet.Range("A7").Activate
                    ActiveWindow.DisplayHeadings = False
                    ActiveWindow.DisplayGridlines = False
                    oSheet.Protect DrawingObjects:=False, AllowFiltering:=True
                Case Else
                    oSheet.Visible = xlSheetHidden
                End Select
            Next oSheet
            UpdateSlicer sCache:=.SlicerCaches("Slicer_View"), strCompare:="All DP & VPO", bShow:=True
           
' >> save changes managers copy
            .Save

            ' save OVP copy and modify accordingly
           

            .SaveAs Filename:=strDir & "PD Discussion Documents\" & strFolderDate & "\" & strDataDate & " PFR Metrics.xlsx", _
                    FileFormat:=xlOpenXMLWorkbook, _
                    ConflictResolution:=xlLocalSessionChanges

            .Sheets("Injury_CM_5Q").Delete
            UpdateSlicer sCache:=.SlicerCaches("Slicer_View"), strCompare:="All VPO Only", bShow:=True

            Application.DisplayAlerts = True           

' >> save changes OVP copy
            .Save

' === return to where we left of ===
            Application.Workbooks.Open Filename:=sMasterCopyFullName
               
' === release current .xlsx (!!) workbook and its macros from memory ===
            .Close
           
            MsgBox "This message will never be displayed..."
        End With
    End If
End Sub

 

[Phuels]

Thanks everyone for the help with this. @GWteB, I had no idea the macro would keep running even if I saved the file with a non-macro enabled extension...game changer!

also, sorry for not replying that this worked sooner...things have been a bit hectic IRL this past month, and I just now got a chance to read your posts.

Thanks again,

Frank