Option Explicit
Sub SaveFileToFixedPath()
Dim dt As String, MyName As String, fullName As String, fullName2 As String
Dim FileExtFind As String, FileNameFind As String, count As Integer
'dt = Format(CStr(Now), "yyyy_mm_dd_hh_mm")
dt = Format(CStr(Now), "yyyy_mm_dd")
Const csPath As String = "F:\EXCEL FILE\"
'ExtFind = Split(Filename, ".")(UBound(Split(Filename, ".")))
MyName = ActiveWorkbook.Name
count = Len(MyName) - Len(Replace(MyName, ".", ""))
FileExtFind = Split(MyName, ".")(UBound(Split(MyName, ".")))
FileNameFind = Split(MyName, ".")(LBound(Split(MyName, ".")))
'If MyName = "*.*" Then
If count >= 1 Then
fullName = FileNameFind & "_" & dt & "." & FileExtFind
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs fileName:=csPath & fullName
Application.DisplayAlerts = True
Else
'fullName = MyName & "_" & dt & ".xlsm"
'If FileExtFind = "" Then
fullName2 = FileNameFind & "_" & dt & "." & ".xlsx"
Application.DisplayAlerts = False
ActiveWorkbook.SaveCopyAs fileName:=csPath & fullName2
Application.DisplayAlerts = True
End If
End Sub