NeilJ
07-21-2018, 10:52 AM
I have some VBA which uses the Value in C18 for the filename that is supposed to populate the ActiveWorkbook SaveAs part of the code. This worked perfectly in Excel 2010 but since upgrading to 2016 the code runs to the ActiveWorkbook SaveAs but the value of C18 is not populating the the dialog.
Any suggestions are very welcome as I can't get to the bottom of this at all.
Thanks
Neil
Option Explicit
Sub SaveAs()
Dim newcase As String
Dim Filename As String
Dim InitialFilename As String
Dim ReturnValue As String
ReturnValue = MsgBox("Please ensure both the BS1192 compliant and Metadata fields are completed before saving" & vbCrLf & vbCrLf & _
"Press Yes to Continue or No to Exit", 68, "FILE SAVE AS INFORMATION")
If ReturnValue = vbYes Then
'The Do ... Loop Until makes the SaveAs dialog keep displaying until the user either
'enters a filename that doesn't exist already (Dir(NewCase) = "")
'or presses cancel (NewCase = False)
Do
ChDrive "L:"
ChDir "L:\Tenders"
Filename = Range("C18").Value & ".xlsm" 'Change extension here; Macro enabled as default
newcase = Application.GetSaveAsFilename( _
InitialFilename:=Filename, _
Title:="Save Compliant Name As")
Loop Until Dir(newcase) = "" Or newcase = "False"
'The parameters here tell the SaveAs dialog to save it as an Excel macro enable file
'with extension .xlsm. Displays a Custom Dialog title on dialog box title bar
'NewCase is now the name the user typed into the Save As dialog
If newcase <> "False" Then
ActiveWorkbook.SaveAs Filename:=newcase, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
Else
MsgBox "Please complete the BS1192 & Metadata Fields; refer to CAD Standards for codes"
End If
End Sub
Any suggestions are very welcome as I can't get to the bottom of this at all.
Thanks
Neil
Option Explicit
Sub SaveAs()
Dim newcase As String
Dim Filename As String
Dim InitialFilename As String
Dim ReturnValue As String
ReturnValue = MsgBox("Please ensure both the BS1192 compliant and Metadata fields are completed before saving" & vbCrLf & vbCrLf & _
"Press Yes to Continue or No to Exit", 68, "FILE SAVE AS INFORMATION")
If ReturnValue = vbYes Then
'The Do ... Loop Until makes the SaveAs dialog keep displaying until the user either
'enters a filename that doesn't exist already (Dir(NewCase) = "")
'or presses cancel (NewCase = False)
Do
ChDrive "L:"
ChDir "L:\Tenders"
Filename = Range("C18").Value & ".xlsm" 'Change extension here; Macro enabled as default
newcase = Application.GetSaveAsFilename( _
InitialFilename:=Filename, _
Title:="Save Compliant Name As")
Loop Until Dir(newcase) = "" Or newcase = "False"
'The parameters here tell the SaveAs dialog to save it as an Excel macro enable file
'with extension .xlsm. Displays a Custom Dialog title on dialog box title bar
'NewCase is now the name the user typed into the Save As dialog
If newcase <> "False" Then
ActiveWorkbook.SaveAs Filename:=newcase, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
Else
MsgBox "Please complete the BS1192 & Metadata Fields; refer to CAD Standards for codes"
End If
End Sub