I have a VBA script in place so that if a cell is blank then Excel will prompt the file to be saved.
This is ensure that the template is not altered. However, when the user clicks save in the "Save As" dialogue box, the file does not save.
This is the code I am using:
If Worksheets("Input").Range("E2").Value = "" Then
Application.EnableEvents = False
Application.GetSaveAsFilename InitialFileName:="\\ac35542\Problem Management\Action Plans\ChangeMe.xlsm", FileFilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm"
Application.EnableEvents = True
MsgBox "Please ensure fill in the Problem Reference Number, Problem Title, and Select a Contract", vbExclamation, "PR Reference & Title"
Worksheets("Input").Select
Range("E2").Select
End If
Why is the file not saving?
As follow up from MSDN
Application.GetSaveAsFilename displays the standard Save As dialog box
and gets a file name from the user without actually saving any
files..
use this one instead:
Dim fileSaveName
If Worksheets("Input").Range("E2").Value = "" Then
Application.EnableEvents = False
fileSaveName = Application.GetSaveAsFilename(InitialFileName:="\\ac35542\Problem Management\Action Plans\ChangeMe.xlsm", FileFilter:="Excel Macro-Enabled Workbook (*.xlsm),*.xlsm")
Application.EnableEvents = True
If fileSaveName <> "False" Then
Application.DisplayAlerts = False
ThisWorkbook.SaveAs (fileSaveName)
Application.DisplayAlerts = True
End If
MsgBox "Please ensure fill in the Problem Reference Number, Problem Title, and Select a Contract", vbExclamation, "PR Reference & Title"
Worksheets("Input").Select
Range("E2").Select
End If
I think Dmitry Pavliv's method is fine, but I think the "InitialFileName:="\ac35542\Problem Management\Action Plans\ChangeMe.xlsm" part makes it a little bit less dynamic.
For me, the below code worked perfectly:
ExportPath = Application.GetSaveAsFilename(FILEFILTER:="Excel Files (*.xlsx), *.xlsx", Title:="")
'Basically, user will specify the path and give it a name and click on Save. It won't get saved until the next line though.
ActiveWorkbook.SaveAs (ExportPath)
Related
When I am trying to run the code below the following happens:
1) It opens a "Save PDF File As" Window
2) I have to manually type in the name
3) The code runs
I want to automate steps 1 and 2 so that the code runs without any manual inputs from me and saves it as whatever.pdf in whatever path.
I tried using ExportAsFixedFormat but the problem is that it is saving only the first page as pdf and the remaining 100+ records that are going through the mail merge are not being saved. On top of that, it still opens that Dialog Window from step 1.
ActiveDocument.ExportAsFixedFormat OutputFilename:=whatever.pdf, _
ExportFormat:=wdExportFormatPDF, etc.
The code:
Sub DoMailMerge()
Set myMerge = ActiveDocument.MailMerge
If myMerge.State = wdMainAndSourceAndHeader Or _
myMerge.State = wdMainAndDataSource Then
With myMerge.DataSource
.FirstRecord = 1
.LastRecord = 3
End With
End If
With myMerge
.Destination = wdSendToPrinter
.Execute
End With
End Sub
Any help on this would be greatly appreciated!
[Edit] Corrected object reference. Added SaveAs2
In the OP, an attempt is made to use a pseudo printer to save as a pdf. There are differences between the SaveAs pdf format and the variety of pdf pseudo printers. Is there a reason for printing to a PDF and saving that file, rather than doing a Save As and choosing the PDF format?
With myMerge
.Destination = wdSendToNewDocument
.Execute
End With
ActiveDocument.SaveAs2 "path & filename", wdFormatPDF
The following is sometimes needed to silence prompting with scripted saves. For the above tested method, there were no prompts, so it may not be needed.
Toggle off .DisplayAlerts before SaveAs
Application.DisplayAlerts = wdAlertsNone
ActiveDocument.SaveAs2 "path & filename", wdFormatPDF
Application.DisplayAlerts = wdAlertsAll
Or
Dim tempDisplayAlerts As Long
tempDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = wdAlertsNone
ActiveDocument.SaveAs2 "path & filename", wdFormatPDF
Application.DisplayAlerts = tempDisplayAlerts
As the title states my msgbox within my userform is stuck in an infinite loop.
I decided to include every command button code there is on this form in case it will help to solve this problem. Also there is also one textbox as well. I've tried various types of loops except the For Loop because every For Loop example I have seen has a counter or some form of increment formula.
What I would like to happen in my loop is if the user clicks on the command button labeled open and txtbxSelectFile.value = "" then display the message box and keep doing this every time the cmdbtnOpen_Click is true and txtbxSelectFile.value = "".
The only thing that came close to working, was the If ... Then conditional statement but it would not loop. It would only run once and then continued to the Else condition. Or maybe a better explanation would be if the user keeps clicking the open button and there is nothing in the textbox then keep displaying the message box.
The value from the textbox is supposed to come from a file browse button. When the user clicks the browse button a file dialog opens so the user can locate the file they want to open.
Private Sub cmdBrowse_Click()
'myFile = Application.GetOpenFilename(, , "Select a File.")
Dim fname As String
Dim fpath As String
fpath = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = fpath
.ButtonName = "Get File Name"
.Title = "File Selection"
.Filters.Clear
.Filters.Add "Excel Files", "*.xl; *.xlsx; *.xlsm; *.xlb; *.xlam; *.xltx; *.xltm; *.xls; *.xla; *.xlt; *.xlm; *.xlw"
.AllowMultiSelect = False
If .Show = True Then
fname = .SelectedItems(1)
Me.txtbxSelectFile.Text = fname
Else
MsgBox "Operation Canceled"
Unload Me
End If
End With
End Sub
Private Sub cmdbtnOpen_Click()
Do While txtbxSelectFile = ""
MsgBox "Please Select a file", vbOKOnly, "No File Selected"
Loop
Workbooks.Open Me.txtbxSelectFile
Unload Me
selectRangefrm.Show
End Sub
I really hope my explanation makes sense. Thank you.
How about a slightly different approach? Why not make the .Enabled property of the Open button dependent upon the value of txtbxSelectFile?
That way, the Open button can't be pressed until a value sits in txtbxSelectFile.
In design mode, change the property of the Open button: set .Enabled to False and then use:
Private Sub cmdBrowse_Click()
'myFile = Application.GetOpenFilename(, , "Select a File.")
Dim fname As String
Dim fpath As String
fpath = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = fpath
.ButtonName = "Get File Name"
.Title = "File Selection"
.Filters.Clear
.Filters.Add "Excel Files", "*.xl; *.xlsx; *.xlsm; *.xlb; *.xlam; *.xltx; *.xltm; *.xls; *.xla; *.xlt; *.xlm; *.xlw"
.AllowMultiSelect = False
If .Show = True Then
fname = .SelectedItems(1)
Me.txtbxSelectFile.Text = fname
Else
MsgBox "Operation Canceled"
End If
cmdbtnOpen.Enabled = Me.txtbxSelectFile.Text <> ""
End With
End Sub
Private Sub cmdbtnOpen_Click()
Workbooks.Open Me.txtbxSelectFile
Unload Me
selectRangefrm.Show
End Sub
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 am trying to retain the original workbook opened and close all other saved(saved with different names) files without reopening. I am doing the SaveAs through a button click. Any suggestions on this?
sub save()
Application.DisplayAlerts= False
FileName1 = Range("D4")
ActiveWorkbook.SaveCopyAs FileName:="C:\Users\felonj\Desktop\list\" & FileName1 & "-" & "Audit checklist" & ".xlsm"
MsgBox "File Saved successfully!", , "Save"
Application.DisplayAlerts = True
End sub
If I have to use your code, try something like this:
Option Explicit
Sub save()
Dim obj_wb As Object
Set obj_wb = ThisWorkbook
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & "Audit checklist" & ".xlsm"
MsgBox "File Saved successfully!", , "Save"
Debug.Print obj_wb.Name
Application.DisplayAlerts = True
Set obj_wb = Nothing
End Sub
obj_wb is the old file, accessible through this variable. Probably it is a good idea to use "ThisWorkbook" in stead of "ActiveWorkbook". Or to refer it always as a variable and not to use any of those at all.
I have a template with a header/footer and text formatting. I would like to write a macro to fill this template with the contents of an .rtf or .doc file. Also, I would like to merge the formatting so that I keep the header and formatting from the template file, and the pictures in the .rtf or .doc files.
Cut-and-paste works great. If I open and save the template file, open the file to insert, select all, and paste special with "merge formatting", then I get exactly what I want. I just want a more scalable solution.
I wrote a macro that does most of this, but it fails to merge the formatting and drops (or hides) the header and footer. I thought the correct approach would use the InsertFile method, but I can't figure it out.
Any pointers would be appreciated (I'm new to both Word and VBA).
Sub InsertFile()
currentPath = ActiveDocument.Path
Set FileBox = Application.FileDialog(msoFileDialogFilePicker)
With FileBox
.Title = "Select the File that you want to insert"
.InitialFileName = currentPath & "\" & "*.rtf"
.AllowMultiSelect = False
If .Show = -1 Then
FiletoInsert = .SelectedItems(1)
End If
End With
Selection.Range.InsertFile FiletoInsert
Set FileBox = Nothing
End Sub
Update - I also tried this approach, which seems to use cut-and-paste, but the results are the same.
Here's the best that I can do. It pastes as plain text, but that's better than nothing (or pasting with original formatting).
Sub InsertFile()
' inserts selected file into current document (strips formatting)
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Select the File that you want to insert"
.Show
FiletoInsert = .SelectedItems(1)
End With
' get content from my file
Application.Documents.Open (FiletoInsert)
Application.Selection.WholeStory
Application.Selection.Copy
Application.ActiveWindow.Close
' paste without formatting
Application.Selection.PasteSpecial DataType:=wdPasteText
End Sub
Sub InsertFile()
' inserts selected file into current document (strips formatting)
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Select the File that you want to insert"
.Show
FiletoInsert = .SelectedItems(1)
End With
Selection.InsertFile FileName:=FiletoInsert, Range:="", _
ConfirmConversions:=False, Link:=False, Attachment:=False
End Sub
I've tried this same call in my own VBA macro, and find that
Selection.Range.InsertFile (FiletoInsert)
Seems to work when I only pass the one parameter filename. Make sure the filename is complete.