I would like to open an Excel file which has a date variable at the end. To date I have created an okay code to retrieve the file based on working backwards from the current date. I would prefer a userform or input box to specify the exact date needed. The date is in the ddmmyyyy format and is at the end of the filename. Any help is much appreciated.
Sub OpenLatest()
---Opens a sheet based on date, searches backward from today til it finds a matching date
Dim TestDate As Date
Dim StartWB As String
Const sPath As String = "C:\Users\Laurence\Documents\"
Const dtEarliest = #6/1/2015# '--to stop loop if file not found by earliest valid date.
TestDate = Date
StartWB = ActiveWorkbook.Name
While ActiveWorkbook.Name = StartWB And TestDate >= dtEarliest
On Error Resume Next
Workbooks.Open sPath & "Firstmacro_dtetime1 " & Format(TestDate, "ddmmyyyy") & ".xlsx"
TestDate = dtTestDate - 1
On Error GoTo 0
Wend
If ActiveWorkbook.Name = sStartWB Then MsgBox "Earlier file not found."
End Sub'
You can use the InputBox() function to request a date from the user.
Dim strDate As String
strDate = InputBox("Enter a date:")
If Not IsDate(strDate) Then
MsgBox "Not a date"
Exit Sub
End If
' Create the file path...
Dim strPath As String
strPath = "C:\Users\Laurence\Documents\Firstmacro_dtetime1 " & Format$(strDate, "ddmmyyyy") & ".xlsx"
' Make sure it exists...
With CreateObject("Scripting.FileSystemObject")
If .FileExists(strPath) Then
Workbooks.Open strPath
End If
End With
Related
Hi Everyone I am very new to coding but have been having some success by teaching myself, I learn or am able to figure things out most easily by reverse engineering I apologise if this seems overly simple but I have not been able to find any relevant examples to convert.
I am trying to write a code in VBA that opens and prints a set of files based on an array derived from the current date or alternatively from an input box
The filenames are all date specific ddmmyyarea1
i.e. 180818area1
What I need it to do is
Get todays date i.e. 17/08/18 +1 to have date 18/08/18
open the files that contain that date in their name 180818area1 then 180818area2 and so on
the reason I haven't asked for the whole script is that I prefer to learn by putting the basic building blocks together, however I am struggling on this aspect above
thanks in advance
Below is my 'estimate' of what I think the code might look like, once again I am very new to this:
Sub BatchPrintWordDocuments()
Dim objWordApplication As New Word.Application
Dim strFile As String
Dim strFolder As String
InputBox("Enter the date to print ddmmyy")
strFolder = file path
strFile = Dir(strFolder & InputBox & Area* vbNormal)
While strFile <> ""
With objWordApplication
.Documents.Open (strFolder & strFile)
End With
strFile = Dir()
Wend
Set objWordApplication = Nothing
End Sub
You might give this a try, you were very close. Put in your own FilePath
Sub BatchPrintWordDocuments()
Dim objWordApplication As New Word.Application
Dim strFile As String
Dim strFolder As String
Dim strDate As String '<<< add this and use it
strDate = InputBox("Enter the date to print ddmmyy")
strFolder = "C:\donPablo\StackOverFlow\" '<<< file path, with trailing slash
strFile = Dir(strFolder & strDate & "Area*.XLS*", vbNormal)
While strFile <> ""
With objWordApplication
.Documents.Open (strFolder & strFile)
'<<< do your stuff here
.Documents.Close (False) '<<< close it, and don't save changes
End With
strFile = Dir()
Wend
Set objWordApplication = Nothing
End Sub
I want to create multiple saves of the same word file using visual basic. each file will need to be named with the day of the month and month name (not numbers) i want this to run from the 1 to 31 on each month. i have a rough code,
Sub Mine()
Dim DateStr, FileStr As String
DateStr = Format$(Date, "DD")
FileStr = DateStr & ".docx"
ActiveDocument.Save
ChangeFileOpenDirectory "Z:\FIR MASTER FOLDER\FCR briefing sheet\2018\Test"
ActiveDocument.SaveAs2 FileName:=FileStr, FileFormat:=wdFormatXMLDocument
End Sub
now how do i add the loop and the day and month format part
try the below. If you want in the format you mention in comment simply put as
Debug.Print monthName & " " & i
Saving to different folders in an amendment to your original question. I am happy to update but this should deal with your initial question as posed.
It works with the current month. You would want a test to make sure doesn't already exist. I tried to show you each of the functions you might consider and how you could structure a loop.
Uses a function from here for end of month.
Sub test()
Dim myDate As Date
Dim myMonth As Long
myDate = Date
Dim monthName As String
monthName = Format$(myDate, "mmmm")
Dim endOfMonth As Long
endOfMonth = CLng(Format$(dhLastDayInMonth(myDate), "dd"))
Dim i As Long
For i = 1 To endOfMonth
Debug.Print monthName & " " & i
Next i
End Sub
Function dhLastDayInMonth(Optional dtmDate As Date = 0) As Date
' Return the last day in the specified month.
If dtmDate = 0 Then
' Did the caller pass in a date? If not, use
' the current date.
dtmDate = Date
End If
dhLastDayInMonth = DateSerial(Year(dtmDate), _
Month(dtmDate) + 1, 0)
End Function
So save with the filename you would do something like:
For i = 1 To endOfMonth
ActiveDocument.SaveAs fileName:= "C:\Test\" & monthName & " " & i, FileFormat:=wdFormatXMLDocument
Next i
Reference:
http://www.java2s.com/Code/VBA-Excel-Access-Word/Word/TosaveadocumentwithanewnameusetheSaveAsmethod.htm
Or to create folders for the year:
Sub AddFoldersAndFiles()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Dim fso As FileSystemObject ' ''early binding. Requires reference to MS Scripting runtime
'Set fso = New FileSystemObject ''early binding
Dim myYear As Long
Dim endOfMonth As Long
Dim filePathStub As String
filePathStub = "C:\Users\User\Desktop\" ' path to create folders at
myYear = Year(Date)
Dim monthsArray() As Variant
monthsArray = Array("January","February","March","April","May","June","July","August","September","October","November","December")
Dim currentMonth As Long
For currentMonth = LBound(monthsArray) To UBound(monthsArray)
Dim folderName As String
folderName = filePathStub & monthsArray(currentMonth) & CStr(myYear)
folderName = fso.CreateFolder(FolderName)
endOfMonth = CLng(Format$(dhLastDayInMonth(DateSerial(myYear,currentMonth + 1, 0)),"dd"))
Dim currentDay As Long
For currentDay = 1 To endOfMonth
ActiveDocument.SaveAs2 FileName:= folderName & Application.PathSeparator & monthsArray(currentMonth) & " " & currentDay, FileFormat:= wdFormatXMLDocument
Next currentDay
Next currentMonth
End Sub
I have a macro to see if a cell contains this string if so executes a "save as" command with this set name standard. When I try to run the macro the if statements seem to not work. When I go through step by step it hits the if statements but saves the personal.xlsb instead of the file I'm working on. Here the code I know I have something wrong with it
Dim FName As String
Dim FPath As String
Dim answer As Integer
If ActiveWorkbook.Sheets("Sheet1").Range("A1") = "String1" Then
FPath = "C:\String1"
FName = Sheets("Sheet1").Range("A1").Text
If Len(FPath & "\" & FName) = 0 Then
answer = MsgBox("Do you want to Save File As: " & FName & "?", vbYesNo + vbQuestion, "Microsoft Excel")
If answer = vbYes Then
ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
End If
Else
ThisWorkbook.Save
End If
End If
I am open to suggestion the most I was is to check if the file contains a string if so verify it does not already exist and if so just save instead of save as.
ThisWorkbook refers to the workbook where the code resides. Presumably, the code being in the Personal.xlsb, that is why it's saving the XLSB file and not the activeworkbook.
Try this instead:
Dim FName As String
Dim FPath As String
Dim fullName As String
Dim rng As Range
Dim s as String
s = "String1"
With ActiveWorkbook
Set rng = .Sheets("Sheet1").Range("A1")
If rng.Value = s Then
FPath = "C:\" & s
FName = rng.Text
fullName = FPath & "\" & FName
If Len(fullName) = 0 Then
If MsgBox("Do you want to Save File As: " & FName & "?", vbYesNo + vbQuestion, "Microsoft Excel") = vbYes Then
.SaveAs Filename:=fullName
End If
Else
.Save
End If
End If
End With
I can't figure out how to delete these excel files programmatically, say when they are 5 days(5 working days) old or older. I was able to figure out how to delete them if they are 5 days older then current date but the weekends and holiday, etc. leave some
undeleted.
Any help will be greatly appreciated,
here is code for backup excel files.
Dim backupfolder As String
backupfolder = "E:/CLIENTS/ExcelBackup/BackupJM/"
Dim savedate
savedate = Date ' Current system date
Dim savetime
savetime = Time ' Current system time
Dim formattime As String
formattime = Format(savetime, "hh.mm.ss")
Dim formatdate As String
formatdate = Format(savedate, "DD-MM-YYYY")
Application.DisplayAlerts = False
'Application.Run ("Auto_Save")
ActiveWorkbook.SaveCopyAs fileName:=backupfolder & formatdate & " " & formattime & " " &
ActiveWorkbook.Name
ActiveWorkbook.Save
Application.DisplayAlerts = True
MsgBox "Backup Run. Please Check at: " & backupfolder
Pretty simple question really, I suppose. How can I amend the below so that rather than looking at LOI.CSV it looks at all .CSV files in the Intraday Folder?
LastSaved = FileDateTime("W:\Settlements\Intraday\LOT.csv")
If LastSaved < Date Then
MsgBox ("The current day file for LOI was last saved " & LastSaved)
End If
Try this
Const sPath As String = "W:\Settlements\Intraday\"
Sub LoopThroughFilesInAFolder()
Dim StrFile As String
StrFile = Dir(sPath & "\*.Csv")
Do While Len(StrFile) > 0
Debug.Print FileDateTime(sPath & "\" & StrFile)
'~~> Rest of the code here
StrFile = Dir
Loop
End Sub