LordDragon
10-06-2015, 01:41 PM
Greetings,
I am trying to use a code to create a SaveAs button for my Workbook.
Here is the code:
Public Sub SaveProjectAs(control As IRibbonControl)
'Saves the Workbook as a new file to preserve the data in the project.
'Declare the Variables for Saving the File
Dim fileSaveName As String
Dim techSaveName As String
Dim customerSaveName As String
'Declare the Variables for the Directory Path
Dim fileRootPath As String
Dim fileSavePath As String
'Declare the Varialbles for the Input Boxes
Dim contractorInput As String
Dim operatorInput As String
Dim techInput As String
Dim customerInput As String
'Unhide the sheets if still hidden
Call UnhideWorksheets
'Make the System Selection page the focus point
Application.Goto Sheets("Rig Survey Form").Range("B4"), True
'Check the Customer Name & Field Tech Name fields for content. If there, use the content, if not provide an input box for entering the data.
With Sheets("Rig Survey Form")
If .Range("D4").Value = "" Then
.Range("D4").Select
contractorInput = InputBox("Please enter the Drilling Contractor Name.", "Drilling Contractor Name")
ActiveCell.FormulaR1C1 = contractorInput
End If
If .Range("C6").Value = "" Then
.Range("C6").Select
operatorInput = InputBox("Please fill in the Operator Name.", "Operator Name")
ActiveCell.FormulaR1C1 = operatorInput
End If
End With
Application.Goto Sheets("System Selection").Range("B4"), True
With Sheets("System Selection")
If .Range("B6").Value = "" Then
.Range("B6").Select
techInput = InputBox("Please fill in the Field Tech's Name.", "Field Tech Name")
ActiveCell.FormulaR1C1 = techInput
End If
If .Range("B4").Value = "" Then
.Range("B4").Select
customerInput = InputBox("Please fill in the Customer Name.", "Customer Name")
ActiveCell.FormulaR1C1 = customerInput
End If
fileSaveName = CleanFileName(.Range("B6").Value) & " - IBU Inventory BOM" & ".xlsm"
techSaveName = CleanFileName(.Range("B6").Value) & "\"
customerSaveName = CleanFileName(.Range("B4").Value) & "\"
End With
'Set the Root Path
fileRootPath = ThisWorkbook.Path & "\"
'Set the sub paths
fileSavePath = fileRootPath & customerSaveName & techSaveName & fileSaveName
ActiveWorkbook.SaveAs Filename:=fileSavePath & fileSaveName
End Sub
I realize the code is a little bulky and it asks the user to fill in the Contractor and Operator fields, then doesn't seem to use them for anything. But that is because the Customer field is really a Drop Menu that is populated from those two fields. I also realize that entering the data via the Input box makes filling those in moot, but most the users won't and I don't want them to get used to using the SaveAs button to fill in the data, there are other methods for that.
The two functions called are the UnhideWorksheets (this works fine) and the CleanFileName one:
Function CleanFileName(sFileName As String, Optional ReplaceInvalidwith As String = "") As String
'Removes invalid filename characters
Const InvalidChars As String = "%~:\/?*<>|"""
Dim ThisChar As Long
CleanFileName = sFileName
For ThisChar = 1 To Len(InvalidChars)
CleanFileName = Replace(CleanFileName, Mid(InvalidChars, ThisChar, 1), ReplaceInvalidwith)
Next
End Function
The code works fine all the way to the part where it tries to save the file.
I'm getting this error code:
14520
I can't see a reason for it not to work, but it isn't.
I'm not dead set on using this version and am open to other suggestions.
I am trying to use a code to create a SaveAs button for my Workbook.
Here is the code:
Public Sub SaveProjectAs(control As IRibbonControl)
'Saves the Workbook as a new file to preserve the data in the project.
'Declare the Variables for Saving the File
Dim fileSaveName As String
Dim techSaveName As String
Dim customerSaveName As String
'Declare the Variables for the Directory Path
Dim fileRootPath As String
Dim fileSavePath As String
'Declare the Varialbles for the Input Boxes
Dim contractorInput As String
Dim operatorInput As String
Dim techInput As String
Dim customerInput As String
'Unhide the sheets if still hidden
Call UnhideWorksheets
'Make the System Selection page the focus point
Application.Goto Sheets("Rig Survey Form").Range("B4"), True
'Check the Customer Name & Field Tech Name fields for content. If there, use the content, if not provide an input box for entering the data.
With Sheets("Rig Survey Form")
If .Range("D4").Value = "" Then
.Range("D4").Select
contractorInput = InputBox("Please enter the Drilling Contractor Name.", "Drilling Contractor Name")
ActiveCell.FormulaR1C1 = contractorInput
End If
If .Range("C6").Value = "" Then
.Range("C6").Select
operatorInput = InputBox("Please fill in the Operator Name.", "Operator Name")
ActiveCell.FormulaR1C1 = operatorInput
End If
End With
Application.Goto Sheets("System Selection").Range("B4"), True
With Sheets("System Selection")
If .Range("B6").Value = "" Then
.Range("B6").Select
techInput = InputBox("Please fill in the Field Tech's Name.", "Field Tech Name")
ActiveCell.FormulaR1C1 = techInput
End If
If .Range("B4").Value = "" Then
.Range("B4").Select
customerInput = InputBox("Please fill in the Customer Name.", "Customer Name")
ActiveCell.FormulaR1C1 = customerInput
End If
fileSaveName = CleanFileName(.Range("B6").Value) & " - IBU Inventory BOM" & ".xlsm"
techSaveName = CleanFileName(.Range("B6").Value) & "\"
customerSaveName = CleanFileName(.Range("B4").Value) & "\"
End With
'Set the Root Path
fileRootPath = ThisWorkbook.Path & "\"
'Set the sub paths
fileSavePath = fileRootPath & customerSaveName & techSaveName & fileSaveName
ActiveWorkbook.SaveAs Filename:=fileSavePath & fileSaveName
End Sub
I realize the code is a little bulky and it asks the user to fill in the Contractor and Operator fields, then doesn't seem to use them for anything. But that is because the Customer field is really a Drop Menu that is populated from those two fields. I also realize that entering the data via the Input box makes filling those in moot, but most the users won't and I don't want them to get used to using the SaveAs button to fill in the data, there are other methods for that.
The two functions called are the UnhideWorksheets (this works fine) and the CleanFileName one:
Function CleanFileName(sFileName As String, Optional ReplaceInvalidwith As String = "") As String
'Removes invalid filename characters
Const InvalidChars As String = "%~:\/?*<>|"""
Dim ThisChar As Long
CleanFileName = sFileName
For ThisChar = 1 To Len(InvalidChars)
CleanFileName = Replace(CleanFileName, Mid(InvalidChars, ThisChar, 1), ReplaceInvalidwith)
Next
End Function
The code works fine all the way to the part where it tries to save the file.
I'm getting this error code:
14520
I can't see a reason for it not to work, but it isn't.
I'm not dead set on using this version and am open to other suggestions.