Create Output File

[tinamiller1]

I have a template that my team uses all the time and I don't want them to alter anything in this template so it is password protected. However, when they fill in the fields that are required, I want them to beable to when they click the save or the blue disk, the file to save based on certain criteria. 1) It saves to their directory, which happens to be C. 2) It is under their username. 3) It saves in documents. 4) It saves in an audit folder they keep on their machine. 5) It saves the filename based on the cells I am capturing in the code.

Here is my code:




Option Explicit
Private Sub Workbook_Open()
Dim wSheet As Worksheet
For Each wSheet In Worksheets
wSheet.Protect Password:="secret", _
UserInterFaceOnly:=True
Next wSheet
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Start As Boolean
Dim Rng1 As Range
Dim Prompt As String, RngStr As String
Dim Cell As Range

Sheets("Form").Unprotect Password:="secret"
Set Rng1 = Sheets("Form").Range("B4, B7, B8, B9, B12, B74, G9, A16, B10, D10, E74, E77")
'message is returned if there are blanks or no value in required fields
Prompt = "Please make sure are highlighted fields are filled in." & vbCrLf & _
"The following cells are incomplete and have been highlighted yellow:" _
& vbCrLf & vbCrLf
Start = True
'highlights the blank cells
For Each Cell In Rng1
If Cell.Value = vbNullString Or Cell.Value = 0 Or Cell.Value <= 0 Then
Cell.Interior.ColorIndex = 6 ' color yellow
If Start Then RngStr = RngStr & Cell.Parent.name & vbCrLf
Start = False
RngStr = RngStr & Cell.Address(False, False) & ", "
Else
Cell.Interior.ColorIndex = 0 '** no color
End If
Next
Sheets("Form").Protect Password:="secret", _
UserInterFaceOnly:=True
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
If RngStr <> "" Then
MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
Cancel = True
Else
'saves the changes before closing
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & _
"\Documents\Audits\" & Range("B9").Text & Chr(32) & Range("B7").Text & _
Range("B10").Text & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True

End If
Set Rng1 = Nothing

End Sub



This works if I takeout the range B10 and that cell is formatted as date *3/14/2001, however I want it to save the date in the file name.

Can anyone help???

[Paul_Hossler]

Not tested, but Format() returns a string




ActiveWorkbook.SaveAs Filename:="C:\Users\" & Environ$("username") & _
"\Documents\Audits\" & Range("B9").Text & Chr(32) & Range("B7").Text & _
Format (Range("B10").Value, "m/dd/yyyy") & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False



Paul