I am new to macros and I used the Workbook_AfterSave function on VBA. For some reason, it keeps looping the save function. I don't know how to get rid of this. It saves the excel file forever and eventually crashes. This is the code.
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"F:\Ten Year Load Forecasts 2017-2026.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Add in a Static variable to prevent the recursion:
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Static bHere as Boolean
If bHere then Exit Sub
bHere = True
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"F:\Ten Year Load Forecasts 2017-2026.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True
bHere = False
End Sub
You can set the EnableEvents property of the Application object to False to prevent the event firing again when you save in the Workbook_AfterSave event.
The code below gets the current status of the flag; sets it to False; runs your original code; and then resets the flag in the error handler. You should have an error handler here in case of an IO error during your save and putting the reset in the error handler ensures the EnableEvents setting is restored to the original value. Example code:
Option Explicit
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim blnSetting As Boolean
' IO operations should have an event handler
On Error GoTo CleanExit
' remember existing setting and set flag to False
blnSetting = Application.EnableEvents
Application.EnableEvents = False
' your original code
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"F:\Ten Year Load Forecasts 2017-2026.xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
CleanExit:
If Err.Number <> 0 Then
' handle error
Debug.Print Err.Description
End If
' reset the Application flag here
Application.EnableEvents = blnSetting
End Sub
Related
I want to prevent the user from saving the VSTO project.
Public Class ThisWorkbook
Private Sub ThisApplication_WorkbookBeforeSave(Wb As Workbook, SaveAsUI As Boolean, ByRef Cancel As Boolean) Handles ThisApplication.WorkbookBeforeSave
Cancel = True
End Sub
end Class
My goal is to set one variable like VbaSave (as Boolean) and with one sub in VBA assign True or False at this variable then save or not the project.
The new code in my head will be:
in VSTO
Public Class ThisWorkbook
public VbaSave as Boolean = false
Private Sub ThisApplication_WorkbookBeforeSave(Wb As Workbook, SaveAsUI As Boolean, ByRef Cancel As Boolean) Handles ThisApplication.WorkbookBeforeSave
if VbaSave= false then Cancel = True
End Sub
end Class
In a VBA module
sub mysave()
myPath = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files (*.xlsx), *.xlsx", title:="Save PO", _
InitialFileName:=ThisWorkbook.Path)
If myPath = "Falso" Then
msgStr = "ATTENTION !!!" & vbCrLf & "operazione annullata," & vbCrLf & _
"nessun file verrà salvato."
MsgBox msgStr, vbInformation, "Revi4Utility.Info"
GoTo done
Else
VbaSave=true
ActiveWorkbook.SaveCopyAs fileName:=myPath
VbaSave=false
End If
end sub
This example crashes when I run mysave. The debug told me that VbaSave is not defined.
I created a public Boolean variable on VBA, and one function to retrieve the variable value.
In VSTO with .Application.Run I call the VBA function and I get the value.
VBA code:
' I define boolean value
Public SysSave As Boolean 'and I assign False like a STD value on my Ribbon load
'one function to get SysSave value
Function CanSave() As Boolean
CanSave = SysSave
End Function
' the sub to save the file
sub mysave()
myPath = Application.GetSaveAsFilename(FileFilter:= _
"Excel Files (*.xlsx), *.xlsx", title:="Save PO", _
InitialFileName:=ThisWorkbook.Path)
If myPath = "Falso" Then
msgStr = "ATTENTION !!!" & vbCrLf & "operazione annullata," & vbCrLf & "nessun file verrà salvato."
MsgBox msgStr, vbInformation, "Revi4Utility.Info"
GoTo done
Else
SysSave=true
ActiveWorkbook.SaveCopyAs fileName:=myPath
SysSave=false
End If
end sub
VSTO code:
'Then I change the VSTO code
Public Class ThisWorkbook
Public SysSave As Boolean = False
Private Sub ThisApplication_WorkbookBeforeSave(Wb As Workbook, SaveAsUI As Boolean, ByRef Cancel As Boolean) Handles ThisApplication.WorkbookBeforeSave
SysSave = Globals.ThisWorkbook.Application.Run("CanSave")
If SysSave = False Then Cancel = True
End Sub
End Class
I'm using Excel 2010. I have an Excel macro-enabled template that has a data connection to a text file that is set to automatically refresh when a new document is created using this template.
The following macro is within the "ThisWorkbook" object to remove the data connection before saving the new document:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Do While ActiveWorkbook.Connections.Count > 0
ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
Loop
End Sub
When a user clicks the save icon / hits ctrl+S, inputs a filename and then clicks save to save as a macro-free Excel workbook (as is the default and required filetype) they are prompted with a message stating:
The following features cannot be saved in macro-free workbooks:
• VB project
To save a file with these features, click No, and then choose a
macro-enabled file type in the File Type list.
To continue saving as a macro-free workbook, click Yes.
Is it possible to prevent this message from appearing and have Excel assume that the user wants to continue with a macro-free workbook?
I've searched all over and understand that I may be able to add code to the workbook object that removes itself so that Excel has no VB project to cause this message but this would require each user to change Trust Center Settings (Trust access to the VBA project object model) which I want to avoid.
I've also seen suggestions of using:
Application.DisplayAlerts = False
but can't get this to work. Every example of it's use seems to be within a sub that is also handling the saving of the document whereas in my situation the BeforeSave sub ends before the document is saved in the default, non-vba way which is perhaps why it does not work?
Does this property reset to a default True after the sub has ended / before the save actually occurs?
Apologies for any nonsense I may have dispensed, my experience with VBA is very limited.
I cannot test on Excel 2010, but at least for 2016, it's working fine:
Sub SaveAsRegularWorkbook()
Dim wb As Workbook
Dim Path As String
Set wb = ThisWorkbook
Path = "T:\he\Path\you\prefer\"
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs Filename:=Path & "Test.xlsx", FileFormat:=51
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Give it a try.
Different approach... when the template is loaded, require the user to save as (I have a workbook/template with a similar situation...). This should open them up to the user's Documents folder, though you can adjust to save to whatever location.
Inside of the ThisWorkbook module, put:
Option Explicit
Private Sub Workbook_Open()
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End Sub
Edit1: Adding the if statement using a base-template name, so subsequent saves do not prompt the save-as:
Option Explicit
Private Sub Workbook_Open()
If ActiveWorkbook.Name = "_NAME_OF_FILE.xlsb" Then
Dim loc As Variant
Application.DisplayAlerts = False
loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\_NAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End If
End Sub
For this answer, I'm assuming that by Excel macro-enabled template, you mean a xltm file. I also guess that what you mean by "new document" is the document that is generated when a user double-clicks on the xtlm file (hence this new file has no location on since it hasn't been saved yet).
To solve your issue, you could use a custom SaveAs window (Application.GetSaveAsFilename) to have more control on how the user saves the file when the Workbook_BeforeSave event macro gets called.
Here is how to implement it:
1 - Copy this code into a new module.
Option Explicit
Sub SaveAsCustomWindow()
Const C_PROC_NAME As String = "SaveAsCustomWindow"
Dim strFullFileName As String, strPreferedFolder As String, strDefaultName As String
Dim UserInput1 As Variant, UserInput2 As Variant
Dim isValidName As Boolean, isFileClosed As Boolean, isWorkbookClosed As Boolean
Dim strFilename As String, strFilePath As String
'To avoid Warning when overwriting
Application.DisplayAlerts = False
'Disable events (mostly for the BeforeSave event) to avoid creating infinite loop
Application.EnableEvents = False
On Error GoTo ErrHandler
'Customizable section
strDefaultName = ThisWorkbook.Name
strPreferedFolder = Environ("USERPROFILE")
Do While isWorkbookClosed = False
Do While isFileClosed = False
Do While isValidName = False
UserInput1 = Application.GetSaveAsFilename(InitialFileName:=strPreferedFolder & "\" & strDefaultName, FileFilter:="Excel Workbook (*.xlsx),*.xlsx")
If UserInput1 = False Then
GoTo ClosingStatements 'This is important to take care of the case when the user presses cancel
Else
strFullFileName = UserInput1
End If
strFilename = Right(strFullFileName, Len(strFullFileName) - InStrRev(strFullFileName, "\"))
strDefaultName = strFilename
strFilePath = Left(strFullFileName, InStrRev(strFullFileName, "\") - 1)
strPreferedFolder = strFilePath
'If the file exist, ask for overwrite permission
If Dir(strFullFileName) <> "" Then
UserInput2 = MsgBox(strFilename & " already exists." & vbNewLine & "Do you want to overwrite?", vbYesNoCancel Or vbExclamation)
If UserInput2 = vbNo Then
isValidName = False
ElseIf UserInput2 = vbYes Then
isValidName = True
ElseIf UserInput2 = vbCancel Then
GoTo ClosingStatements
Else
GoTo ClosingStatements
End If
Else
isValidName = True
End If
Loop
'Check if file is actually open
If isFileOpen(strFullFileName) Then
MsgBox "The workbook you want to overwrite is currently open. Choose a different name, or close the workbook before saving.", vbExclamation
isValidName = False
isFileClosed = False
Else
isFileClosed = True
End If
Loop
'Check if an opened workbook has the same name
If isWorkbookOpen(strFilename) Then
MsgBox "You cannot save this workbook with the same name as another open workbook or add-in. Choose a different name, or close the other workbook or add-in before saving.", vbExclamation
isValidName = False
isFileClosed = False
isWorkbookClosed = False
Else
isWorkbookClosed = True
End If
Loop
ThisWorkbook.SaveAs Filename:=strFullFileName, FileFormat:=xlOpenXMLWorkbook
ClosingStatements:
Application.EnableEvents = True
Application.DisplayAlerts = True
Exit Sub
ErrHandler:
Call MsgBox("Run-time error '" & Err.Number & "': " & Err.Description & vbNewLine & _
"While running: " & C_PROC_NAME & IIf(Erl <> 0, vbNewLine & "Error Line: " & Erl, "")
GoTo ClosingStatements
End Sub
Function isFileOpen(ByVal Filename As String) As Boolean
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open Filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: isFileOpen = False
Case 70: isFileOpen = True
End Select
End Function
Function isWorkbookOpen(ByVal Filename As String) As Boolean
Dim wb As Workbook, ErrNo As Long
On Error Resume Next
Set wb = Workbooks(Filename)
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: isWorkbookOpen = True
Case Else: isWorkbookOpen = False
End Select
End Function
Explanation of part 1: This whole thing might seem a bit overkill, but all the error handling is important here to take into account potential errors and make sure that the setting for Application.EnableEvents is turned back to TRUE even if an error occurs. Otherwise, all event macros will be disabled in your Excel application.
2 - Call the SaveAsCustomWindow procedure inside the Workbook_BeforeSave event procedure like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Your code
If ThisWorkbook.Path = "" Then
SaveAsCustomWindow
Cancel = True
End If
End Sub
Note that we need to set the variable Cancel = True in order to prevent the default SaveAs window to show up. Also, the if statement is there to make sure that the custom SaveAs window will only be used if the file has never been saved.
To answer your questions:
Is it possible to prevent this message from appearing?
Yes, using the Application.DisplayAlerts property
Is it possible to have Excel assume that the user wants to continue with a macro-free workbook?
No, you have to write the procedure to save the workbook and bypass the SaveAs excel event and save the workbook using the user input (Path & Filename) with the required format.
The following procedure uses a FileDialog to capture the Path and Filename from the user then saves the file without displaying the warning message.
I have added some explanatory comments nevertheless, let me know of any questions you might have.
Copy these procedures in the ThisWorkbook module:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True 'Prevents repetitive Save
Call Workbook_BeforeSave_ApplySettings_And_Save
End Sub
Private Sub Workbook_BeforeSave_ApplySettings_And_Save()
Dim fd As FileDialog, sFilename As String
Rem Sets FileDialog to capture user input
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.InitialView = msoFileDialogViewDetails
.Title = vbNullString 'Resets default value in case it was changed
.ButtonName = vbNullString 'Resets default value in case it was changed
.AllowMultiSelect = False
If .Show = 0 Then Exit Sub 'User pressed the Cancel Button
sFilename = .SelectedItems(1)
End With
With ThisWorkbook
Do While .Connections.Count > 0
.Connections.Item(.Connections.Count).Delete
Loop
Application.EnableEvents = False 'Prevents repetition of the Workbook_BeforeSave event
Application.DisplayAlerts = False 'Prevents Display of the warning message
On Error Resume Next 'Prevents Events and Display staying disable in case of error
.SaveAs Filename:=sFilename, FileFormat:=xlOpenXMLWorkbook 'Saves Template as standard excel using user input
If Err.Number <> 0 Then
MsgBox "Run-time error " & Err.Number & String(2, vbLf) _
& Err.Description & String(2, vbLf) _
& vbTab & "Process will be cancelled.", _
vbOKOnly, "Microsoft Visual Basic"
End If
On Error GoTo 0
Application.DisplayAlerts = True
Application.EnableEvents = True
End With
End Sub
I have a xl file with about 2000 rows and columns from A to H. I was trying to sort the file based on the column D such that all other columns are also sorted accordingly (expand selection area).
I am very new to Macros and have been doing this small task to save some time on my reporting.
Here's what I tried:
Prompt the user to select a file
Set the columns from A to H
Sort Range as D2
Save the file
As I said, I am new, I have used much of the code from sample examples in the MSDN library. Apart from Sort(), every thing else is working for me.
here's the code
Sub Select_File_Windows()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
Dim SHEETNAME As String
'Default Sheet Name
SHEETNAME = "Sheet1"
' Save the current directory.
SaveDriveDir = CurDir
' Set the path to the folder that you want to open.
MyPath = Application.DefaultFilePath
' Open GetOpenFilename with the file filters.
Fname = Application.GetOpenFilename( _
FileFilter:="XLS Files (*.xls),*.xls,XLSX Files (*.xlsx),*.xlsx", _
Title:="Select a file", _
MultiSelect:=True)
' Perform some action with the files you selected.
If IsArray(Fname) Then
With Application
.ScreenUpdating = False
.EnableEvents = True
End With
For N = LBound(Fname) To UBound(Fname)
' Get only the file name and test to see if it is open.
FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
If bIsBookOpen(FnameInLoop) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(Fname(N))
On Error GoTo 0
DoEvents
If Not mybook Is Nothing Then
Debug.Print "You opened this file : " & Fname(N) & vbNewLine
With mybook.Sheets(SHEETNAME)
'Columns("A:H").Sort Key1:=Range("D2:D2000"), Order1:=xlAscending, Header:=xlYes
'Range("A1:H2000").Sort Key1:=Range("D1"), Order1:=xlAscending
Columns("A:H").Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlYes
End With
Debug.Print "Sorter Called"
mybook.Close SaveChanges:=True
End If
Else
Debug.Print "We skipped this file : " & Fname(N) & " because it is already open. Please close the data file and try again"
End If
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Nothing is working for me. The file stays as is and No update is made to it. I could not understand, what is the newbie mistake I have been making here ?
Please help.
References:
https://msdn.microsoft.com/en-us/library/office/ff840646(v=office.15).aspx
http://analysistabs.com/vba/sort-data-ascending-order-excel-example-macro-code/
Run time error 1004 when trying to sort data on three different values
It may be as simple as adding a couple of dots (see pentultimate line below)
With mybook.Sheets(SHEETNAME)
'Columns("A:H").Sort Key1:=Range("D2:D2000"), Order1:=xlAscending, Header:=xlYes
'Range("A1:H2000").Sort Key1:=Range("D1"), Order1:=xlAscending
.Columns("A:H").Sort Key1:=.Range("D1"), Order1:=xlAscending, Header:=xlYes
End With
SJR is correct in saying that your references should be fully qualified inside of the With Statement.
You should simplify your subroutines by extracting large blocks of code into separate subroutines. The fewer tasks that a subroutines handles, the easier it is to read and to debug.
Refactored Code
Sub Select_File_Windows()
Const SHEETNAME As String = "Sheet1"
Dim arExcelFiles
Dim x As Long
arExcelFiles = getExcelFileArray
If UBound(arExcelFiles) = -1 Then
Debug.Print "No Files Selected"
Else
ToggleEvents False
For x = LBound(arExcelFiles) To UBound(arExcelFiles)
If IsWorkbookOpen(arExcelFiles(x)) Then
Debug.Print "File Skipped: "; arExcelFiles(x)
Else
Debug.Print "File Sorted: "; arExcelFiles(x)
With Workbooks.Open(arExcelFiles(x))
With .Sheets(SHEETNAME)
.Columns("A:H").Sort Key1:=.Range("D1"), Order1:=xlAscending, Header:=xlYes
End With
.Close SaveChanges:=True
End With
End If
Next
ToggleEvents True
End If
End Sub
Function IsWorkbookOpen(ByRef szBookName As String) As Boolean
On Error Resume Next
IsWorkbookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function getExcelFileArray()
Dim result
result = Application.GetOpenFilename( _
FileFilter:="Excel Workbooks, *.xls; *.xlsx", _
Title:="Select a file", _
MultiSelect:=True)
If IsArray(result) Then
getExcelFileArray = result
Else
getExcelFileArray = Array()
End If
End Function
Sub ToggleEvents(EnableEvents As Boolean)
With Application
.ScreenUpdating = EnableEvents
.Calculation = IIf(EnableEvents, xlCalculationAutomatic, xlCalculationManual)
.EnableEvents = EnableEvents
End With
End Sub
I have to do this whenever I save the excel file:
Save the file at one drive location (overwrite if same name file exists)
Go back to original location of the file and save it there as well (overwrite the file)
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim thisPath As String
Dim oneDrivePath As String
thisPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name
oneDrivePath = "C:\Users\Folder\OneDrive\" & ThisWorkbook.Name
ActiveWorkbook.SaveAs _
Filename:=oneDrivePath
Do
Loop Until ThisWorkbook.Saved
ActiveWorkbook.SaveAs _
Filename:=thisPath
Do
Loop Until ThisWorkbook.Saved
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
But this doesn't works it's stucks in an infinte loop or Excel goes in Not Responding State. Anyidea how to achieve this task ?
The reason I can think of why it fails is maybe it's triggered everytime the file is saved but shouldn't Application.EnableEvents = False stop it from happening ? '
EDIT#1:
I tried stepping through the code it goes into Not Responding State after the Code gets though End Sub line
FileCopy may be useful here, since you don't care to overwrite the data, I think that would save you the loop for saved state (since Filesystem Object would take care of resolving the network delays ideally). I'd change the logic to:
1. Save this workbook
2. Overwrite my desired location
3. User is left in the original workbook since you are only saving a copy of this workbook.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FileSystemLibrary As Variant: Set FileSystemLibrary = CreateObject("Scripting.FileSystemObject")
Dim thisPath As String: thisPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Dim oneDrivePath As String: oneDrivePath = "C:\Users\Folder\OneDrive\" & ThisWorkbook.Name
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
ThisWorkbook.Save
FileSystemLibrary.CopyFile FileSystemLibrary.GetFile(thisPath), oneDrivePath
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
you don't need to loop if all your doing is saving. try the below
Sub save()
pathForFirstSave = "C:\folder1\"
pathForSecondSave = "C:\anotherFolder\"
ActiveWorkbook.SaveAs Filename:=pathForFirstSave & "asdf.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:=pathForSecondSave & "asdf.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
I want reopen a read-only workbook as read and write to change value's with a macro.
I want suppression of the private sub workbook_open by reopen workbook:
Private Sub Workbook_Open()
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly
Can anyone help me with this problem?
I know that I have to use a temporary workbook for running the macro for reopening. But I can't find the right vba code.
Say we have a workbook called yesterday.xlsm which we want to open but we do NOT yesterday's Open Event macro to trigger. Run this in another workbook:
Sub PardonMyParanoia()
Application.EnableEvents = False
Workbooks.Open Filename:="C:\TestFolder\yesterday.xlsm"
End Sub
This is NOT tested code but should open a workbook with macros disabled.
Public Function OpenWorkbookWithMacrosDisabled(ByRef filePathAndName As String, Optional ByRef openReadOnly As Boolean = False) As Boolean
' Stores the current security settings
' sets the security to High, then opens the workbook
' Sets the security settings back to their original settings
' Simon Leten 27-Jun-2014
Dim secAutomation As MsoAutomationSecurity
Dim nameOfFile As String
Dim result As Boolean
' *** Leave errors to get handled by the calling proc ***
' On Error GoTo ErrorHandler
' *** Leave errors to get handled by the calling proc ***
Const PROC_NAME As String = "OpenWorkbookWithMacrosDisabled"
result = False
secAutomation = Application.AutomationSecurity
nameOfFile = Dir$(filePathAndName)
If nameOfFile = "" Then
Err.Raise vbObjectError + 0, PROC_NAME, "Cannot find the file '" & filePathAndName & "'."
Else
If WorkbookIsOpen(nameOfFile) Then
Err.Raise vbObjectError + 0, PROC_NAME, "A file with the name '" & nameOfFile & "' is already open."
Else
Application.AutomationSecurity = msoAutomationSecurityForceDisable
Application.Workbooks.Open Filename:=filePathAndName, ReadOnly:=openReadOnly, AddToMru:=False
result = True
End If
End If
ExitProc:
Application.AutomationSecurity = secAutomation
OpenWorkbookWithMacrosDisabled = result
Exit Function
End Function