I have a excel file that is referenced in my macro that is named inventory report " today's date " ex. ( Inventroy report 11_01_2017) I was trying to find a way for VBA to always reference the file with the current date in its name
If you want to get the current file name, plus the current date, you can do:
Sub t()
Dim fileName As String, curDate As String
curDate = Date
fileName = ActiveWorkbook.Name
fileName = Left(fileName, InStr(fileName, ".") - 1)
fileName = fileName & " " & curDate
Debug.Print fileName
End Sub
If you need date with _ instead of / you can add:
curDate = WorksheetFunction.Substitute(date, "/", "_")
Related
I am trying to save file in a specific folder, add the filename, and add todays date. My VBA is not working. Any suggestions?
Sub SaveFile()
ActiveWorkbook.SaveAs ("G:\Product Support\Platinum\Agents Case Reports\Michael\Saved Client Reports\CAF\CAF Open Case Report.xlsx") & Date
End Sub
You can do this:
Public Sub SaveFile()
Dim formattedDate As String
formattedDate = Format(Now, "yyyy-mm-dd hh-mm-ss")
Dim filename As String
' path + filename + formatted date + extension
filename = _
"G:\Product Support\Platinum\Agents Case Reports\Michael\Saved Client Reports\CAF\" & _
"CAF Open Case Report - " & _
formattedDate & _
".xlsx"
ActiveWorkbook.SaveAs filename
End Sub
Whenever I output a date on a filename I always make sure it will sort chronologically. In the code above this is yyyy-mm-dd hh-mm-ss, which is year-month-day hour-minute-second. All numbers have leading zeroes, where necessary. An example from a few moments ago is "2021-08-03 17-58-59".
File name cannot contain "/" character which is in the date you should firstly store Current Date in a variable then replace "/" from it before passing it to file name
Sub SaveFile()
Dim CurrentDate as string
CurrentDate = Date
CurrentDate = Replace(CurrentDate, "/", "_")
CurrentDate = Replace(CurrentDate, ".", "_")
ActiveWorkbook.SaveAs ("G:\Product Support\Platinum\Agents Case Reports\Michael\Saved Client Reports\CAF\CAF Open Case Report " & CurrentDate & ".xlsx")
End Sub
This would work now.
I have a VBA macro in Excel which opens both the source and targets files, copies the required data and closes the files. The target filename is always the same, but the source file is a new file every day with the date as part of the name. The name format is SB20200613.DBF. This is today's file 13 June. For all of 2020, the files will always be SB2020XXXX.DBF.
Here is the macro
Public Sub Copy_DBF_to_Workbook()
Const cRootFolder As String = "C:\Price\" ' <<<<< change accordingly (without year!)
Const cDestWorkBk As String = "Prices.xlsx"
Dim oWsSrc As Worksheet
Dim oWsDest As Worksheet
Dim raSrc As Range
Dim raDest As Range
Dim sPath As String
Dim sDBF As String
Dim sFName As String
Dim dtDate As Date
' assign current date
dtDate = Date
' assign yesterday's date
' dtDate = Date - 1
' compose path for current year
sPath = cRootFolder & Year(dtDate) & "\"
' compose file name
sDBF = "SB" & Year(dtDate) & IIf(Len(Month(dtDate)) = 1, "0" & Month(dtDate), Month(dtDate)) & _
IIf(Len(Day(dtDate)) = 1, "0" & Day(dtDate), Day(dtDate)) & ".dbf"
' check within folder on existence of file
sFName = Dir(sPath & sDBF)
If Len(sFName) > 0 Then
' open DBF file
On Error Resume Next
Set oWsSrc = Workbooks.Open(sPath & sFName).ActiveSheet
If oWsSrc Is Nothing Then GoTo ERROR_DBF
' open destination workbook
Set oWsDest = Workbooks.Open(sPath & cDestWorkBk).ActiveSheet
On Error GoTo 0
If oWsDest Is Nothing Then GoTo ERROR_PRICES
' determine range to be copied
With oWsSrc.Cells.CurrentRegion
Set raSrc = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
End With
' determine destination; first available row in column B
Set raDest = oWsDest.Cells(oWsDest.Rows.Count, "B").End(xlUp).Offset(1, 0)
' perform copy
raSrc.Copy Destination:=raDest
' save prices.xlsx
oWsDest.Parent.Save
oWsDest.Parent.Close
' close DBF
oWsSrc.Parent.Close SaveChanges:=False
Else
MsgBox "DBF file [" & sPath & sDBF & "] not found.", vbExclamation
End If
GoTo DONE
ERROR_DBF:
MsgBox "Error opening DBF file " & sPath & sDBF, vbExclamation
Exit Sub
ERROR_PRICES:
MsgBox "Error opening workbook " & sPath & cDestWorkBk, vbExclamation
DONE:
End Sub
That works well for today, but I also have a data created each day for the following day, so I need to duplicate this macro, but have it look not for today's file, but for tomorrow's file. I tried simply making this change
' assign current date
dtDate = Date + 1
but the macro still performs the task on today's data file.
Any thoughts on what requires changing to have the macro open tomorrows DBF file instead?
cheers
I have a line of code to open up a workbook based on a dt string that I specify.
Const filename = "Labor_Data_"
Const basepath = "C:\Users\CDL File"
Dim wbPreviousData as workbook
Dim dt As String: dt = Format(DateAdd("m", -1, Now), "mm_yyyy")
and then I open up the previous months file with:
Set wbPreviousData = Workbooks.Open(basepath & "\" & filename & dt & ".xlsx")
But I realize that my company's fiscal calendar can sometimes span 5 weeks, e.g. (last week of March - to - first week of May)
Is there an easy way to update my code to just reference the most recent month that is saved in a file pathway that I specify?
You have to scan all the files in the directory to find the latest
Sub findlatest()
Const filename = "Labor_Data_"
Const basepath = "C:\Users\CDL File"
Dim file As String, absfile As String
Dim latest As String, ts As Double, tsmax As Double
file = Dir(basepath & "\" & filename * "*")
Do While Len(file) > 0
' check timestamp
absfile = basepath & "\" & file
ts = CDbl(FileDateTime(absfile))
If ts > tsmax Then
tsmax = ts
latest = file
End If
file = Dir
Loop
Debug.Print latest
End Sub
I get full path of an Excel file from a cell and use a function to retrieve the file name. I have final result as "abc.xlsx"
I need to insert a time stamp in the file name like "abc_02_11_19.xlsx".
I am able to generate the time stamp, the problem is appending it. The best I could think of was to remove the last five letters from the file name i.e. ".xlsx", append the time stamp and then append the ".xlsx".
The ending might also be ".xlsm", ".xlsb" or ".xls". I would need to extract everything after the dot.
Any better way to do this or if not, how best to do it elegantly?
Snippet of code, I am using-
oldname = FunctionToGetName(ThisWorkbook.Sheets("Sheet1").Range("B10").Text)
newname = FileDateTime(ThisWorkbook.Sheets("Sheet1").Range("B10").Text) & " " & oldname
newname = Replace(Replace(Replace(newname, ":", "_"), "/", "_"), "*", "_")
This inserts the time stamp before the file name. I need to append it after.
I've not tested this with your functions as I don't know what they do. But if I'm correct, the FunctionToGetName will return the filename as "filename.extention" and FileDateTime will return the date stamp you wish to attach.
With this you can get the filename by cutting everything after the "." with Left$(filename, InStr(oldname, ".") - 1). Then you can do the reverse of that and add the file extention back with Right$(oldname, Len(oldname) - InStr(oldname, ".")). And as per below, you can put pretty much anything in between.
Sub what()
Dim filename As String
Dim oldname As String
oldname = FunctionToGetName(ThisWorkbook.Sheets("Sheet1").Range("B10").Text)
Newname = Left$(filename, InStr(oldname, ".") - 1) & " " & FileDateTime(ThisWorkbook.Sheets("Sheet1").Range("B10").Text) & "." & Right$(oldname, Len(oldname) - InStr(oldname, "."))
End Sub
Check out FSO
Dim fso as object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oldname As String
Dim newname As String
oldname = "abc.xlsx"
newname = fso.GetBaseName(oldname) & "_" & Format(Now(), "mm_dd_yy") & "." & fso.GetExtensionName(oldname)
Debug.Print newname
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object
The code below shows my save macro. Right now it saves the current workbook in a specific file path with the current workbook name. How can I add today's date in the current workbook name? So it saves to the designated file path with the current workbook name and today's date on the end?
Sub Save_Workbook()
ActiveWorkbook.SaveAs "H:\HR\Cole G\Timehseet Test Path\" & ActiveWorkbook.Name
End Sub
First off, .Name may or may not include a file extension, depending on if the file has been saved or not. (eg. "Test.xls" or "Book2")
Const Path = "H:\HR\Cole G\Timehseet Test Path\"
Dim Pos as Long
Pos = InStrRev(ActiveWorkbook.Name, ".") - 1
' If there wasn't a ".", then the file doesn't have an extension and Pos = -1
If Pos < 0 then Pos = Len(ActiveWorkbook.Name)
' Now put everything together, including the file extension...
ActiveWorkbook.SaveAs Path & Left(ActiveWorkbook.Name,Pos) & Format(Now, "yyyy-mm-dd") & Mid(ActiveWorkbook.Name,Pos+1)
This should be reliable regardless of file extension (even if there is no file extension!), as long as you're using common Excel file types. If you're opening weird .HTML files it may need some tweaking.
Sub Save_Workbook()
Dim fileNameWithoutExtension as String
fileNameWithoutExtension = getFileNameWithoutExtension(ActiveWorkbook)
ActiveWorkbook.SaveAs "H:\HR\Cole G\Timehseet Test Path\" & fileNameWithoutExtension & Format(Date, "YYYY-MM-DD"), FileFormat:=ActiveWorkbook.FileFormat
End Sub
Function getFileNameWithoutExtension(wb As Workbook)
Dim baseName As String
If (wb.Name = wb.FullName) Then
' This handles files that have not been saved, which won't have an extension
baseName = wb.Name
GoTo EarlyExit
End If
Select Case wb.FileFormat
Case xlOpenXMLAddIn, xlOpenXMLStrictWorkbook, xlOpenXMLTemplate, xlOpenXMLTemplateMacroEnabled, _
xlOpenXMLWorkbook, xlWorkbookDefault
' These all have a 4-character extension
baseName = Left(wb.Name, Len(wb.Name) - 5)
Case Else
' almost every other file type is a 3-character extension,
' but modify if needed based on this enumeration:
' https://msdn.microsoft.com/en-us/vba/excel-vba/articles/xlfileformat-enumeration-excel
baseName = Left(wb.Name, Len(wb.Name) - 4)
End Select
EarlyExit:
getFileNameWithoutExtension = baseName
End Function