Thread: Saving in Excel
View Single Post
  #11   Report Post  
Posted to microsoft.public.excel.misc
S Willingham S Willingham is offline
external usenet poster
 
Posts: 30
Default Saving in Excel


This is the code I'm using

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 QuoteName is in
'Change B1 to the cell your CustomerName is in
QuoteName = Range("E8").Value
CustomerName = Range("B6").Value

'Change to the folder path need to be sure you have a \ at the end of path
SaveToPath = "\\C:\Documents and Settings\FaroTemplate\Desktop\Quotes\"

anyFilename = QuoteName & _
"_" & CustomerName & ".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



I pasted yours and made on modification. I changed the Labels to QuoteName
and CustomerName. Other than that it is just as you wrote it.

Thanks in advance