Try this, this is part of a code that I use myself personally. It asks for the directory, followed by the desired file name. If it's too troublesome for you or your user, feel free to change to suit your needs
Code:
Sub SaveAs()
Dim FileDir, FileName, varFile As Variant
Dim fDialog As Office.FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.AllowMultiSelect = False
.Title = "Please browse to where you would like to save"
.InitialFileName = IIf(Right(Range("D4"), 1) <> "\", Range("D4") & "\", Range("D4"))
If .Show = True Then
For Each varFile In .SelectedItems
FileDir = varFile & "\"
Next
Else
Exit Sub
End If
End With
FileName = Application.InputBox("Please enter a file name to be saved as: " & vbCrLf & "Note: .xlsm may be omitted", Title:="Enter file name to be saved as", Default:="MyWorkBook.xlsm")
GoTo checkFileName
fileBlank:
FileName = Application.InputBox("You did not enter a file name." & vbCrLf & vbCrLf & "Please enter a file name to be saved as: " & vbCrLf & "Note: .txt may be omitted", Title:="Enter file name to be saved as", Default:="MyWorkBook.xlsm")
GoTo checkFileName
fileContainsSpecial:
FileName = Application.InputBox("The file name may not contain any of these characters: " & vbCrLf & "\ / : * ? "" < > |" & vbCrLf & vbCrLf & "Please enter a different file name to be saved as: " & vbCrLf & "Note: .xlsm may be omitted", Title:="Enter file name to be saved as", Default:="MyWorkBook.xlsm")
checkFileName:
If FileName = "False" Then Exit Sub
If FileName = "" Then GoTo fileBlank
If InStr(FileName, Chr(34)) > 0 Or InStr(FileName, "\") > 0 Or InStr(FileName, "/") > 0 Or InStr(FileName, ":") > 0 Or InStr(FileName, "*") > 0 Or InStr(FileName, "?") > 0 Or InStr(FileName, "<") > 0 Or InStr(FileName, ">") > 0 Or InStr(FileName, "|") > 0 Then GoTo fileContainsSpecial
If Right(FileName, 4) <> ".xlsm" Then FileName = FileName & ".xlsm"
ActiveWorkbook.SaveAs FileDir & FileName
End Sub
Bookmarks