We have a system that automatically downloads data and puts it in excel and other sheets. I am trying to write a macro for a master spreadsheet that retrieves the latest version of a certain file to edit, copy and paste into the master sheet.
I have trouble retrieving the file as the filenames include dates.
I am quite new to VBA and am still just throwing pieces of code together to get a working thing, but I cannot find exactly what I am looking for.
Filename is for example 'ML0003 - Daily Order Entry Information - 170927'
The last 6 figures represent the date and changes every time.
This is my code so far:
Dim dtTestDate As Date
Dim sStartWB As String
Const sPath As String = "D:\Berry\AddIn\Testing\"
Const dtEarliest = #1/1/2010#
dtTestDate = Date
sStartWB = ActiveWorkbook.Name
While ActiveWorkbook.Name = sStartWB And dtTestDate >= dtEarliest
On Error Resume Next
Workbooks.Open sPath & "ML0003 - Daily Order Entry Information - " & " ****** " & ".xls"
dtTestDate = dtTestDate - 1
On Error GoTo 0
Wend
If ActiveWorkbook.Name = sStartWB Then MsgBox "Earlier file not found."
I was under the assumtion that the asterix would allow any character there, but this does not seem to work. Any ideas?
You will want to use the Dir function to look for a file using the wildcard, like this:
Dim sFilename As String
While ActiveWorkbook.Name = sStartWB And dtTestDate >= dtEarliest
sFilename = Dir(sPath & "ML0003 - Daily Order Entry Information - *.xls*")
If sFilename <> "" Then Workbooks.Open sPath & sFilename
Wend
Related
Hi there so I finished the section of a program which calculates and exports a csv with results. (ends up about 1600 csv files) each having only 1 column and between 20 and 0 rows. I would like my MS Access VBA program to join them together into one larger CSV. So Same header only once at the top of the new file.
The program i have so far seems to fall over at the part where it tries to import the Reg. Number of the File.
Dim db As DAO.Database
Set db = CurrentDb
MTH = Format(Date, "mmm")
UserInput = InputBox("Enter Country Code")
Dim strSourcePath As String
Dim strDestPath As String
Dim strFile As String
Dim strData As String
Dim x As Variant
Dim Cnt As Long
Dim r As Long
Dim c As Long
Dim wks As Excel.Worksheet
Application.Echo False
'Change the path to the source folder accordingly
strSourcePath = "Q:\CCNMACS\AWD" & CTRY
If Right(strSourcePath, 1) <> "\" Then strSourcePath = strSourcePath & "\"
'Change the path to the destination folder accordingly
strDestPath = "Q:\CCNMACS\AWDFIN"
If Right(strDestPath, 1) <> "\" Then strDestPath = strDestPath & "\"
strFile = Dir(strSourcePath & "*.csv")
Do While Len(strFile) > 0
Cnt = Cnt + 1
If Cnt = 1 Then
r = 1
Else
r = Cells(Rows.Count, "A").End(xlUp).Row + 1
End If
Open strSourcePath & strFile For Input As #1
If Cnt > 1 Then
Line Input #1, strData
End If
Do Until EOF(1)
Line Input #1, strData
x = Split(strData, ",")
For c = 0 To UBound(x)
wks.Cells(r, c + 1).Value = Trim(x(c)) 'Error is here: Run time error '91': Object variable or With Block variable not set
Next c
r = r + 1
Loop
Close #1
Name strSourcePath & strFile As strDestPath & strFile
strFile = Dir
Loop
Application.Echo True
If Cnt = 0 Then _
MsgBox "No CSV files were found...", vbExclamation
Your question isn't absolutely definitive as to what you're trying to do, but if I understand correctly, you just need to append several files to the end of each other, to make "one big CSV".
If that's true then there are several ways to do this a lot simpler than using VBA. .CSV files are just plain text files with comma's separating each field, and a .CSV filename extension.
Personally I would use Notepad++ (I assume it's capable of this; it does everything else), or perhaps even easier, I would use the Windows Command Prompt.
Let's say you have a folder with files:
File1.csv
File2.csv
File3.csv
...etc
Open the Windows Command Prompt. (One way is with the Windows key + R, then type cmd and hit Enter.)
Change directory with to the file location using cd (same as ChDir).
(For example, you might use cd c:\users\myFolder,
and then hit Enter)
To combine all CSV's in the folder into one, you could use a command like:
copy *.csv combinedfile.csv
That's it!
A file is created named combinedfile.csv. You can open in Excel or a text editor (like Notepad) to double-check it and adjust manually if necessary.
Obviously there are many ways you could vary the command, like if you only wanted the files that start with the word File you could use:
copy file*.csv combinedFile.csv
This should do what you want.
Sub Import()
Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String
Dim blnHasFieldNames As Boolean
' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True
' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\your_path_here\"
' Replace tablename with the real name of the table into which
' the data are to be imported
strTable = "Table1"
strFile = Dir(strPath & "*.csv")
Do While Len(strFile) > 0
strPathFile = strPath & strFile
DoCmd.TransferText acImportDelim, "", strTable, strPathFile, blnHasFieldNames
' Uncomment out the next code step if you want to delete the
' EXCEL file after it's been imported
' Kill strPathFile
strFile = Dir()
Loop
End Sub
See the links below for additional details pertaining to this topic.
https://anthonysmoak.com/2018/04/10/how-to-fix-an-import-specification-error-in-microsoft-access/
https://www.oakdome.com/programming/MSAccess_ExportSpecifications_TransferText_To_CSV.php
Hi there I am trying to make a macro that saves a report to a specific folder. Our folders get generated every day like C://Report_Type/2017/11/10 (where /10 is the folder I'd want to save the file to).
The code I have prompts the user to provide the date in order to have the folder located, and then it saves the file according to a specified name.
However when I run the macro it saves the file in the C://Report_Type/2017/11 root folder ignoring the day based on userinput. Could someone help where I got it wrong?
It's a bit complicated to explain, but if you check the code then it makes sense.
Sub PSSaveFile()
Dim myVal2 As Variant
Dim myDate As String
Dim mFilePath As String
myVal2 = InputBox("Please enter today's date in mm\dd format")
myDate = Date - 1
mFilePath = "\\sample\sample_emea\sec_REPORTS\APPS\Reports\Regional\sample_security_app\2017\" & myVal2
ActiveWorkbook.SaveAs FileName:=mFilePath & "SampleLogs-" & myDate & "-12352_checked"
End Sub
Thank you for the help in advance!
Why make it so complicated? I mean why ask for date when you can get that automatically?
Is this what you are trying (UNTESTED)?
Sub PSSaveFile()
Dim FilePath_A As String, FilePath_B As String, FilePath_C As String
Dim sFile As String
FilePath_A = "\\sample\sample_emea\sec_REPORTS\APPS\Reports\Regional\sample_security_app\2017\"
FilePath_B = Format(Date, "mm\dd")
FilePath_C = "\SampleLogs-" & Replace(Date - 1, "/", "-") & "-12352_checked.xlsx"
sFile = FilePath_A & FilePath_B & FilePath_C
ActiveWorkbook.SaveAs sFile, 51
End Sub
Few things
While naming files avoid the use of special characters like \ / : * ? " < > | and hence we use Replace(Date - 1, "/", "-") in the above code
Mention the file extention and file format number
Break your code in easy to understand "parts". makes it easier to understand and manage the code.
Yeah this one is a simpler approach, unfortunately the user who'll be using the macro often checks backlogs so the date she's reviewing isn't always today's or yesterday's date hence the userinput function – Rhyfelwr 14 mins ago
Since you are using InputBox you may want to use this
Sub PSSaveFile()
Dim FilePath_A As String, FilePath_B As String, FilePath_C As String
Dim sFile As String
Dim Ret As Variant
Ret = InputBox("Please enter date in mm\dd format")
If Ret = "" Then Exit Sub
FilePath_A = "\\sample\sample_emea\sec_REPORTS\APPS\Reports\Regional\sample_security_app\2017\"
FilePath_B = Ret
'~~> Check if the folder path exists
If FileFolderExists(FilePath_A & FilePath_B) Then
FilePath_C = "\SampleLogs-" & Replace(Date - 1, "/", "-") & "-12352_checked.xlsx"
sFile = FilePath_A & FilePath_B & FilePath_C
ActiveWorkbook.SaveAs sFile, 51
Else
MsgBox "The folder path " & FilePath_A & FilePath_B & " doesn't exist"
End If
End Sub
Public Function FileFolderExists(strFullPath As String) As Boolean
On Error GoTo Whoa
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
Whoa:
On Error GoTo 0
End Function
I was wondering whether there is a (built in/simple) option to reference/connect/link to a workbook that has a variable name?
My xy-problem is, I have workbook b v45.xlsm and wish to export data to workbook a v34.xlsm where the version numbers vary. So I was wondering if there is a sub-ID for each workbook, to which excel can refence independent of the name, automatically picking the most recent version in that folder.
Of course the simple solution is to pick the most recently modified excel file in the folderpath containing the string "a v", assuming an identical folderpath, but I was curious if there was a more convential/integrated option for this.
Kind regards.
(For future people looking at this issue, here is my manual solution:)
Sub find_planner_name()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim string_object(0 To 2) As String 'saving the filenames as strings
Dim count As Integer 'counting nr of files encountered
Dim save_version_number(0 To 1) As Long
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
'Cells(i + 1, 1) = objFile.name
count = count + 1
ReDim version_number(0 To count) As Long
string_object(0) = ""
string_object(1) = ""
string_object(2) = ""
string_object(0) = objFile.name
If Right(string_object(0), 5) = ".xlsm" Or Right(string_object(0), 5) = ".xlsb" Then
If Left(string_object(0), 10) = " planner v" Or Left(string_object(0), 10) = " planner v" Then
string_object(1) = Right(string_object(0), Len(string_object(0)) - 10)
MsgBox (string_object(1))
Do While IsNumeric(Left(string_object(1), 1)) = True
If IsNumeric(Left(string_object(1), 1)) = True Then
string_object(2) = string_object(2) & Left(string_object(1), 1)
string_object(1) = Right(string_object(1), Len(string_object(1)) - 1)
End If
Loop
If version_number(count) < string_object(2) And string_object(2) > 0 Then
version_number(count) = string_object(2)
MsgBox (version_number(count))
save_version_number(0) = version_number(count)
save_version_number(1) = count
End If
End If
End If
i = i + 1
Next objFile
count = save_version_number(1) 'rewrite maxima back
version_number(count) = save_version_number(0) 'rewrite maxima back
'MsgBox ("done " & version_number(count))
Dim myMax As Long
Dim count_results As Long
For count_results = LBound(version_number, 1) To UBound(version_number, 1)
If version_number(count_results) > myMax Then
myMax = version_number(count_results)
Findmax = count_results
'MsgBox (version_number(count_results))
End If
'MsgBox (version_number(count_results) & " and count_results = " & count_results)
Next count_results
'the name of the planner =
name_planner = " planner v" & version_number(Findmax) & ".xlsm"
' check if xlsm or xlsb
'MsgBox (name_planner)
If Dir(ThisWorkbook.Path & "\" & name_planner) <> "" Then
MsgBox ("File exists. and name is " & name_planner)
Else
name_planner = " planner v" & version_number(Findmax) & ".xlsb"
End If
End Sub
It should be more reliable to parse filenames looking at the version numbers rather than looking at the most recently modified file. Loop through all of them checking the filename with something like:
strFile = Dir(DirectoryPath)
Do while strFile <> ""
'Code here to parse strFile for intNewVersionNumber
if intNewVersionNumber > intVersionNumber then intVersionNumber = intNewVersionNumber
strFile = Dir
Loop
strFile = 'Code here to reconstruct filename from intVersionNumber
From your question, I think this might actually be necessary, even though there may be a couple of ways of adding/checking metadata on Excel files.
When you say the workbook name changes, it is literally the exact same file being renamed through Windows Explorer, or do you have multiple versions in the same folder created when you use Save As...? The issue of "automatically picking the most recent version" suggests that there are new versions being created in the same folder. If so, it means that you're actually changing which workbook you're linking to, so any kind of link to a file isn't going to work anyway. Also, even if you put in a sub-ID, each version will still have that same sub-ID. While this can still identify the files that are different versions of the same file, you still have to loop through all of those files looking for the latest version. A sub-ID would help if the filename is changing entirely, but doesn't remove the need to search through the different versions. So, if you can keep a consistent filename with only the version number changing, you'll be able to implement the simplest solution possible.
Here you have some information regarding my Excel file so you know better my worksheet layout:
it is a normal excel sheet (.xlsx) which starts at row 5 and has many different entries for a table.
Some of this entries are automatically calculated from a function which uses values from cells from the same row.
The document goal is to be a template, so the number of rows containing information may vary depending who is using the template.
Even though the number of rows containing information may vary the functions have to be present at all cells in a column, so whenever someone places a new entry to the table it is automatically calculated.
The formulas are all of them like this: " = if ( #cellvalue <> ""# ; #dosomething# ; #""#) ", which mainly places an empty string if no value is present in a cell, and does someting else if a value is entered.
The template will be cell protected, so only some cells would be able to be modified.
During the last days I've been trying to implement a Button for excel which does the following things on click:
Detect which rows contain table entries, but discarting the rows which contain no manually entered values and may only contain the function stated on the previous paragraph. The table always start at raw 5 but might end at row 50 or 60 or whenever the person who uses it stops to manually enter new entries to the table. It is possible that only the row 5 contains information, but it can never happen that any entry is present in the table.
Create a new ".csv" file, containing only the previously selected rows, on the same folder as the ".xlsx" file which is being used as a template. The ".csv" file name must be the same as the ".xlsx" file, but appending some information present in some specific cells (for example information present in cell A1, B1, A3, C3). The information to be appended will always be string text which will never come from a function output but from manually entered by the keypad. It could be that some of this cells contain no information (empty strings such as: "").
The button action should directly save the file in the same directory where the template is without opening a dialog to save the file. The button should also prompt a dialog in case the name being used for the ".csv" file already exists as a "filename.csv" file in the same folder. This prompted dialog should ask if you would like to overwrite the existing file with the same name with the new one.
Written without Excel on my current PC so you'll need to tinker a bit but something like this:
' Rows that contain entries:
' assuming data is in column A (i.e. col 1)
Dim rowHolderArray() as long
Dim lastRow as long
lastRow = range("A65000").End(xlUp).Row
Redim rowHolderArray(lastRow)
For x = 1 to lastRow
If cells(x,1) <> "" then rowHolderArray(x) = x
next x
2) to populate the csv, create it using the AddWorkbook method then do something like:
Dim rowCounter as long
rowCounter = 1
For x = 0 to UBound(rowHolderArray) - 1
If rowHolderArray(x) <> "" then
cells(rowCounter, 1) = rowHolderArray(x)
rowCounter = rowCounter + 1
End if
Next x
3) To save the book use Application.ActiveWorkbook.Path & "/" & yourWorkBook.name & ".xlsx"
Thanks to everyone, finally I could implement what I wanted. Here you have my example code so you can check it:
Private Sub CommandButton1_Click()
Dim i As Boolean
Dim j As Integer
Dim currentworkbook As String
Dim currentpath As String
Dim csvfilename As String
Dim contentrange As Range
Dim researchername As String
Dim projectname As String
Dim aditional_info As String
Dim year As String
Dim month As String
Dim day As String
Dim hour As String
Dim minute As String
Dim WB As Workbook
Application.DisplayAlerts = False
' Calculate which was the last row with information
i = True
j = 12
While i
j = j + 1
If (Application.Cells(j, 2) = "") Then
i = False
j = j - 1
End If
Wend
' Copy the information I wanted to save in a .csv file
Application.Range(Application.Cells(12, 1), Application.Cells(j, 16)).Copy
' Create some variables to manage the path ant some filenames
currentworkbook = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
currentpath = Application.ActiveWorkbook.Path
csvfilename = currentworkbook & "_"
researchername = Application.Cells(1, 2)
projectname = Application.Cells(3, 2)
aditional_info = Application.Cells(5, 2)
year = Format(Now(), "yy")
month = Format(Now(), "MM")
day = Format(Now(), "dd")
hour = Format(Now(), "Hh")
minute = Format(Now(), "Nn")
' Create a new workbook which will be filled with the information copied and then saved as a .csv file.
Set WB = Workbooks.Add
With WB
.Title = "mytitle"
.Subject = "Mysubject"
.Sheets(1).Select
ActiveSheet.Paste
.SaveAs currentpath & "\" & csvfilename & "_" & year & "-" & month & "-" & day & "_" & hour & "h" & minute & "m_" & projectname & "_" & researchername & "_" & aditional_info, xlCSV
.Close
End With
Application.DisplayAlerts = True
End Sub
Say I have the following path and file name:
P:\...\Annual and Quarterly Budget Data\ECMQA 2012Q1.xls
I want to write an if then statement that does the following (not sure if my statement is set up properly):
If InStr(1, "P:\...\Annual and Quarterly Budget Data\ECMQA 2012Q1.xls", "QA", vbTextCompare) > 0 Then
BD.Sheets("Sheet1").Range("C2").value = "2012Q1"
End If
Instead of just inputting "2012Q1", I want it to automatically read this from the file. The thing is I am actually looping through 12 or so files and there's two types, "ECMQA 2012Q1.xls" (or ECMQB 2012Q2.xls and so on) AND "ECM Annual Budget 2012.xlsx"
If my file is the annual one (If file contains "Annual"), then I want:
BD.Sheets("Sheet1").Range("C2").value = "2012"
And i want it to read this from the actual file, same as the other one...not me putting in "2012"
Is there a way to do this?
Any help will be appreciated!
EDIT:
Here is the loop:
Dim wb As Workbook, sFile As String, sPath As String
Dim itm As Variant
Dim strFileNames As String
sPath = "C:\Actuary\Cash Flow Forecast\Annual and Quarterly Budget Data\"
''Retrieve the current files in directory
sFile = Dir(sPath)
Do While sFile <> ""
strFileNames = strFileNames & "," & sFile
sFile = Dir()
Loop
''Open each file found
For Each itm In Split(strFileNames, ",")
If itm <> "" Then
Set wb = Workbooks.Open(sPath & itm)
''DO LOTS OF CALCULATIONS
'wb.Close True
End If
Next itm
Filesystemobject has a method for extracting the base name from a filename:
Msgbox createobject("scripting.filesystemobject").getbasename("myTest.xlsx") 'myTest
There's lots of ways to get at what you need using split, right, left, mid, or even regex. It really depends on the makeup of the possible source strings and how much variation they contain.
Based soley on your example the following shows various manipulations with the last variable giving "2012"
Sub test()
fPath = "P:\...\Annual and Quarterly Budget Data\ECMQA 2012Q1.xls"
fArray = Split(fPath, "\")
fnamewithtext = fArray(UBound(fArray))
fnamewithoutext = Split(fArray(UBound(fArray)), ".")(0)
ifannual = Left(Split(fArray(UBound(fArray)), " ")(1), 4)
End Sub