try this
Sub SaveWorkbookToFolder()
Dim CustomerName As String
Dim InvoiceNumber As String
Dim SaveToPath As String
Dim userInput As String
Dim anyFilename As String
'Change A1 to the cell your CustomerName is in
'Change B1 to the cell your InvoiceNumber is in
CustomerName = Range("A1").Value
InvoiceNumber = Range("B1").Value
'Change to the folder path need to be sure you have a \ at the end of path
SaveToPath = "\\Sever01\users\Invoices\SavedReports\"
anyFilename = CustomerName & _
"_" & InvoiceNumber & ".xls"
If Dir(SaveToPath & anyFilename) = "" Then
ActiveWorkbook.SaveAs Filename:=SaveToPath & anyFilename
Else
Select Case MsgBox("A file named: '" & anyFilename & " already
exists in " & SaveToPath _
& vbCrLf & "What would you like to do?" & vbCrLf _
& "Overwrite the existing file? [Yes]" & vbCrLf _
& "Save file with a different name? [No]" & vbCrLf _
& "Cancel - do not save this file at this time. [Cancel]", _
vbYesNoCancel + vbExclamation + vbDefaultButton2, "Save Invoice To
Folder")
Case Is = vbYes
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=SaveToPath & anyFilename
Application.DisplayAlerts = True
Case Is = vbNo
userInput = "dummy entry to make it work"
GetFileNameFromUser:
Do While userInput <> ""
anyFilename = InputBox$("Enter a new filename to use:", _
"Commission Manager", CustomerName & _
"_" & InvoiceNumber)
If Right(UCase(Trim(anyFilename)), 4) <> ".XLS" Then
anyFilename = anyFilename & ".xls"
End If
If ValidateFilename(anyFilename) <> "" Then
MsgBox "The filename you have entered is not a valid
filename." _
& vbCrLf & "Filenames may not have any of these
characters in them:" _
& vbCrLf & " \ / : * ? < > | " & Chr$(34) & vbCrLf _
& "Please provide a valid filename.", vbOKOnly,
"Invalid Filename"
GoTo GetFileNameFromUser
End If
If Trim(UCase(anyFilename)) = ".XLS" Then
If MsgBox("You have chosen to Cancel the file save." & _
"Did you really intend to Cancel this operation?", _
vbYesNo + vbInformation, "Confirm Cancel") <> vbYes Then
GoTo GetFileNameFromUser
Else
anyFilename = ":* QUIT *:"
userInput = ""
End If
End If
If userInput <> "" Then
userInput = Dir(SaveToPath & anyFilename)
End If
Loop
If anyFilename <> ":* QUIT *:" Then
ActiveWorkbook.SaveAs Filename:=SaveToPath & anyFilename
End If
Case Else
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True
End Select
End If
End Sub
Private Function ValidateFilename(anyFilename As String) As String
Dim InvalidCharacterList As String
InvalidCharacterList = "\/:*?<>|" & Chr$(34)
Dim LC As Integer
ValidateFilename = ""
If Len(Trim(anyFilename)) = 0 Then
ValidateFilename = "EMPTY"
Exit Function
End If
anyFilename = Trim(anyFilename)
For LC = 1 To Len(anyFilename)
If InStr(InvalidCharacterList, Mid(anyFilename, LC, 1)) Then
ValidateFilename = Mid(anyFilename, LC, 1)
Exit Function
End If
Next
End Function
todd said:
Mike,
thanks for the help, the code works great.
can i get you to help me on one more thing?
Can i make it so that it will save in the dir that i want? it can be the
same one every time on a network drive.
:
try this
Sub SaveWorkbookAs()
Dim CustomerName As String
Dim InvoiceNumber As String
'Change A1 to the cell your CustomerName is in
'Change B1 to the cell your InvoiceNumber is in
CustomerName = Range("A1").Value
InvoiceNumber = Range("B1").Value
Select Case MsgBox("Would you like to save this invoice", vbYesNo)
Case Is = vbYes
Application.ActiveWorkbook.SaveAs CustomerName & _
"_" & InvoiceNumber
Case Is = vbNo
Exit Sub
End Select
End Sub
:
Is there a way that when saving a excel file that i can get a name from a
cell or maybe two?
so if i had an invoice excel sheet that when you go to save it would take
the customers name and the invoice number and make that the file name.