Macro save as from Template
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 wrote:
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
|