Macro save as from Template

[Alon Davis]

I have an Excel document that gets saved on a daily basis. I have it working
except when I save the worksheet as a tempalte it ignores the unc path it is
set to save to and saves it to my documents instead. I think it is because
when you oepn up the template it appends the name of it with a number 1, then
2, and so on. How do I change this code to just save it as "DAR_and then the
Date from Cell B4.xls"

Public Sub SaveAsDate()

Dim fDate As String
Dim fName As String
Dim Pos As Long
Dim blValid As Boolean
Dim fPath As String
Dim fVerify As String

With ActiveSheet.Range("B4")
If Not IsEmpty(.Value) Then
If IsDate(.Value) Then
blValid = True
fDate = Format(.Value, "yyyy-mm-dd")

With .Parent.Parent
Pos = InStr(1, .Name, ".", vbTextCompare)
If Pos > 0 Then
fName = Left(.Name, Pos - 1)
fName = .Name
fPath = "\\pcfile\shared\operations\security\DAR by
dates\"
Else

End If

.SaveAs fPath & "DAR" & "_" & fDate & ".xls"
MsgBox _
prompt:="File saved successfully!", _
Buttons:=vbInformation, _
Title:="File was saved!"
End With
End If


End If
End With

If Not blValid Then MsgBox _
prompt:="No date found in Date field, file not saved!", _
Buttons:=vbCritical, _
Title:="File NOT saved!"

End Sub

 

[Dave Peterson]

It sounds from your description that you want to save the file on that UNC path
with the name Dar_somedate.xls.

Wouldn't something like this do it:

Option Explicit
Public Sub SaveAsDate()

Dim fDate As String
Dim blValid As Boolean
Dim fPath As String

fPath = "\\pcfile\shared\operations\security\DAR by dates\"

blValid = false
With ActiveSheet.Range("B4")
If Not IsEmpty(.Value) Then
If IsDate(.Value) Then
blValid = True
fDate = Format(.Value, "yyyy-mm-dd")

With .Parent.Parent
On Error Resume Next
.SaveAs fPath & "DAR" & "_" & fDate & ".xls"
If Err.Number <> 0 Then
MsgBox Err.Number & vbLf & Err.Description
Err.Clear
Else
MsgBox prompt:="File saved successfully!", _
Buttons:=vbInformation, _
Title:="File was saved!"
End If
On Error GoTo 0
End With
End If
End If
End With

If Not blValid Then
MsgBox prompt:="No date found in Date field, file not saved!", _
Buttons:=vbCritical, _
Title:="File NOT saved!"
End If

End Sub

Looking at your code, I was confused why you were getting the name and checking
for a dot.

If you only wanted to do this save if the file has never been saved before
(right after creating the file based on that template), then you could use:

if activeworkbook.path = "" then
'never been saved
else
'it's been saved at least once
end if

But I'm not sure that's what you were checking.

 

[Alon Davis]

That also works when you are working from the document as a .xls file. when
you save it as a template, it still ignores the unc path and saves it under
the current users my documents instead. Any idea on how to make it save it
to the unc path when you open the document as a tempalte?

Thanks,
Alon

 

[Dave Peterson]

I don't understand.

Did you modify the code to save the workbook as a template or just use
File|SaveAs?

This is the important line to change:

..SaveAs fPath & "DAR" & "_" & fDate & ".xls"

to:

..SaveAs fPath & "DAR" & "_" & fDate & ".xlt", FileFormat:=xlTemplate

 

[Alon Davis]

I did a Save As and then when I open the .xlt Template it ignores the unc
path and saves the document to my documents.

 

[Dave Peterson]

If you do file|SaveAs, then you're not running the macro and excel will behave
the way it wants.

But after you choose template as the file type, you can change to any folder you
want.

 

[Alon Davis]

Thanks Dave for all your help.

I have one more request for this macro.

I would like to include the contents of one more cell in the name of the
document. It is the name of the shift so the final name of the document will
be DAR_Shift_<Date>.xls I would however like to validate the contents before
saving it. Much like the macro verify's it is a valid date before saving the
document. The three shifts are Swing, Power, Graves.

Thanks again for all you help.

 

[Dave Peterson]

I'd use Data|Validation to try to make sure that only Swing, Power, Grave could
be entered in that cell.

See Debra Dalgleish's site for notes about Data|Validation:
http://contextures.com/xlDataVal01.html

Untested, but it did compile:

Option Explicit
Public Sub SaveAsDate()

Dim fDate As String
Dim fShift As String
Dim blValid As Boolean
Dim fPath As String

fPath = "\\pcfile\shared\operations\security\DAR by dates\"

blValid = False
With ActiveSheet.Range("B4")
If Not IsEmpty(.Value) Then
If IsDate(.Value) Then
blValid = True
fDate = Format(.Value, "yyyy-mm-dd")
End If
End If
End With

'what cell contains the shift?
With ActiveSheet.Range("b5")
Select Case LCase(.Value)
Case Is = LCase("Swing"), LCase("Power"), LCase("Grave")
fShift = .Value
'ok
Case Else
blValid = False
End Select
End With

If Not blValid Then
MsgBox prompt:="Check Date and Shift fields, file not saved!", _
Buttons:=vbCritical, _
Title:="File NOT saved!"
Else
With ActiveWorkbook
On Error Resume Next
.SaveAs fPath & "DAR" & "_" & fShift & "_" & fDate & ".xls"
If Err.Number <> 0 Then
MsgBox Err.Number & vbLf & Err.Description
Err.Clear
Else
MsgBox prompt:="File saved successfully!", _
Buttons:=vbInformation, _
Title:="File was saved!"
End If
On Error GoTo 0
End With
End If

End Sub