VBA that imports data meeting certain criteria from all spreadsheets in a directory - vba

This the following code that I have:
Public Function Import_Multi_Excel_Files()
Dim InputFile As String
Dim InputPath As String
InputPath = "L:\Directory\To\Project\Data\"
InputFile = Dir(InputPath & "*.xls*")
worksheetName = "WorksheetThatHasData!A:H"
Do While InputFile <> ""
DoCmd.TransferSpreadsheet acImport, , "Table_1", InputPath & InputFile, -1, worksheetName, True '< The true is for column headers
InputFile = Dir
Loop
End Function
The above code is grabbing all of the data from a specific worksheet within each workbook (which is good) and importing it into MS Access. But I noticed that our reports always include the current month and previous month even though the report is dated for the current month. Every file name has the format Report - YYYYMM. The idea I'm kicking around is something that will look at the YYYYMM portion of the file name and only grab the data with that corresponding date.
Edits and Additions Below
Actuarial_Report-201705
Enrollment_Report-201705
Premium-Data-201705
Each of the above reports includes information from May AND April. But the previous months report will clearly include data from April but also March, and so on. What's happening is that all the data I've imported counted enrollment, premium, and actuarial info twice. I want to only pull 201705 data from the 201705 reports and have the code ignore the 201704 info.

Replace your While loop with the following:
Dim strMonth As String
Dim strYear As String
Do While InputFile <> ""
strMonth = Mid(InputFile, Len(InputFile) - 6, 2)
strYear = Mid(InputFile, Len(InputFile) - 10, 4)
DoCmd.TransferSpreadsheet acImport, , "Table_1", InputPath & InputFile, -1, worksheetName, True '< The true is for column headers
CurrentDb.Execute "DELETE * From Table_1 WHERE MyDateColumn < #" & strYear & "/" & strMonth & "/01#"
InputFile = Dir
Loop
Where MyDateColumn is the column where you store dates.
Assumptions: You are not storing any other old information in Table_1 that you want to keep, else you would want to import to another table, remove the invalid date info, and then append the data to Table_1
The end of the file name cannot change, else this will generate bugs.
Note that I'm not using parameters in my query, but since the string is from a filename and has a max length of 6 with a / in the middle, the risk of SQL injection is not present.

Related

Excel vba - Open files with variable (dates) filenames

I have the below code to open up files with variable file names, due to dates being in them. I personally save each file daily with the date stamp, ie this morning I saved a file with yesterday's date, 4.20.17.
This code will be run every Friday morning, and the goal is to load the last 5 work days' files (last Friday, this Monday, Tues, Wed, Thurs) grab some info out of those files (copy 2 cells from each), paste that info in a new sheet, and finally close each file.
Currently, the code is set to tell me when a file does not exist (for instance, last Friday was Good Friday, so Monday morning, I did not create any file for last Friday), and then ignore and move past that day.
The issue I currently have (besides the code being long and can probably be concatenated) is that a file exists for last Thursday, yet my code tells me there is none. I have been advised that this is because the code is actually looking at today (Thursday) and not a week ago Thursday, where there actually is a file.
Any assistance is appreciated. I removed a few days to make the below code less of a bear to look at, and a sample filename is "Agent Group Daily Summary 4.19.17"
Const strFilePath As String = "D:\Users\stefan.bagnato\Desktop\Daily Performance Summary\Agent Group Daily Summary "
Dim LastFridayDate, MondayDate, TuesdayDate, WednesdayDate, ThursdayDate As String
Dim fullFileNameLastFriday, fullFileNameMonday, fullFileNameTuesday, fullFileNameWednesday, fullFileNameThursday As String
Dim wbkLastFriday, wbkMonday, wbkTuesday, wbkWednesday, wbkThursdayOpen As Workbook
LastFridayDate = Format(Date - (Weekday(Date, vbFriday) - 1), "m.d.yy")
fullFileNameLastFriday = strFilePath & LastFridayDate & ".xls"
If Dir(fullFileNameLastFriday) = "" Then
MsgBox "File for last Friday doesn't exist!"
GoTo ExitLastFriday
End If
Set wbkLastFriday = Workbooks.Open(fullFileNameLastFriday, False, True)
Call BasicDailySummary
wbkLastFriday.Activate
Range("T2:T8").Copy
fp.Activate
Range("B3:B9").PasteSpecial xlPasteValues
wbkLastFriday.Activate
Range("F2:F8").Copy
fp.Activate
Range("G3:G9").PasteSpecial xlPasteValues
wbkLastFriday.Close SaveChanges:=False
ExitLastFriday:
MondayDate = Format(Date - (Weekday(Date, vbMonday) - 1), "m.d.yy")
fullFileNameMonday = strFilePath & MondayDate & ".xls"
If Dir(fullFileNameMonday) = "" Then
MsgBox "File for Monday doesn't exist!"
GoTo ExitMonday
End If
Set wbkMonday = Workbooks.Open(fullFileNameMonday, False, True)
Call BasicDailySummary
wbkMonday.Activate
Range("T2:T8").Copy
fp.Activate
Range("C3:C9").PasteSpecial xlPasteValues
wbkMonday.Activate
Range("F2:F8").Copy
fp.Activate
Range("H3:H9").PasteSpecial xlPasteValues
wbkMonday.Close SaveChanges:=False
ExitMonday:
....................................
ThursdayDate = Format(Date - (Weekday(Date, vbThursday) - 1), "m.d.yy")
fullFileNameThursday = strFilePath & ThursdayDate & ".xls"
If Dir(fullFileNameThursday) = "" Then
MsgBox "File for Thursday doesn't exist!"
GoTo ExitThursday
End If
Set wbkThursday = Workbooks.Open(fullFileNameThursday, False, True)
Call BasicDailySummary
wbkThursday.Activate
Range("T2:T8").Copy
fp.Activate
Range("F3:F9").PasteSpecial xlPasteValues
wbkThursday.Activate
Range("F2:F8").Copy
fp.Activate
Range("K3:K9").PasteSpecial xlPasteValues
wbkThursday.Close SaveChanges:=False
ExitThursday:
That a file exists for last Thursday, yet my code tells me there is none
As I explained in the other question you asked yesterday, putting the vbMonday or vbThursday etc in the Format function doesn't magically tell VBA to return that day:
Hint: The vbFriday part of the Weekday function is not magically telling it to get friday's date. It's actually telling it that, for the sake of this function call, consider Friday to be the first day of the week. The Weekday function then returns an integer (the ordinal day of the week) which it subtracts from the Date.
So, you need to go back and understand how those functions work, you can't just dump constants in there willy-nilly without making an effort to understand what they're doing, or why. On that note, you absolutely need to read this and learn how to begin debugging and troubleshooting first. This describes basics of how to step through your code and examine variable's values/etc at runtime. These techniques are foundations you need to work with VBA.
Here is a list of statements available in VBA. This is documentation that explains things like "How to create a loop structure with For/Next, etc."
And you should go back through the dozen or so questions you've asked here, and mark accepted answers for those where an answer has solved your problem. This is just a basic point of etiquette: You've asked 11 questions here and only accepted 1 answer.
Note also that this sort of declaration does not do what you think it does:
Dim LastFridayDate, MondayDate, TuesdayDate, WednesdayDate, ThursdayDate As String
Dim fullFileNameLastFriday, fullFileNameMonday, fullFileNameTuesday, fullFileNameWednesday, fullFileNameThursday As String
Dim wbkLastFriday, wbkMonday, wbkTuesday, wbkWednesday, wbkThursdayOpen As Workbook
Only the last item in each of those statements are strongly typed, the rest are implicitly variant. You should strongly type all variables when possible, e.g.:
Dim wbkLastFriday As Workbook, wbkMonday As Workbook, wbkTuesday As Workbook, wbkWednesday As Workbook, wbkThursdayOpen As Workbook
And rather than using five different workbook objects (unless you really need 5 workbooks open at once, just use a single workbook object and operate within a loop, opening successive file at each iteration.
Dim wb as Workbook
Dim i as Long
For i = 1 to 5
Set wb = Workbooks.Open(...)
'Do something
wb.Close()
Next
Getting to your actual problem:
A function like below will return an array of your date components. This returns the previous 7 days from the FirstDay (which defaults to Friday previous). You can use the Dir function as previously to simply test whether a filename is valid/existing (e.g., Sunday file doesn't exist, etc.), and skip over it if it's not valid.
Function GetFileNames(Optional FirstDay = vbFriday)
Dim filenames(1 To 7) As String
Dim i As Long
For i = 1 To 7
filenames(i) = Format(Date - (Weekday(Date, FirstDay) + i), "m.d.yy")
Next
GetFileNames = filenames
End Function
It seems that you want your search to start from yesterday instead of today. If so, you can try changing
ThursdayDate = Format(Date - (Weekday(Date, vbThursday) - 1), "m.d.yy")
into
ThursdayDate = Format(Date - (Weekday(Date - 1, vbThursday)), "m.d.yy")
and generalize it to other week days. In fact what it does now is that when it runs, say, on this Thursday, it looks up for the file of last Thursday...

Pick date from cell and use as a file handle while saving

A2=201604
I am trying to pick up value from a Cell(Date) and use the same for saving the file.
But while saving instead of the date a value is being printed, see code below:
Dim part1 as string
part1 = Range("A2").Value
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\xxx- " & Format(part1, "MMM-YYYY") & ".xlsx" , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
201604 is not a date. It is just a number.
You could use something like
myDate = "01/" & right(a2,2) & "/" left(a2,4)
string yourAnswer = format(myDate, "MMM-YYYY")
The problem is you're prematurely casting the Date into a String by using the part1 variable, so the 'date' is already broken and not recognisable as a date by the time it hits your Format() call.
Either declare part1 as a Date or just skip the whole part1 declaration and insert Range('A2').Value directly into the Format() call.

VBA - Converting a mixed row ( Data Type wise) to Date

I have an excel sheet, one of the columns is mixed with Dates and Dates that has been copied to it as text ( see below ).
I dont manage to convert the text type to Date type, i need to do it though VBA to add it to some automation im working on. is there a way to do this at all ?
I noticed excel is looking for format like this 03/09/2016 23:39:57 and it doesn't like 3/21/16 11:07:22 PM, apparently this is my case :) every look i run i get ( obviously data mismatch ), in the image bellow the spoken column is "C"
thx :)
ExcelSheet bad Date format
Assuming wvery bad dates are MM/DD/YYYY, then you could use the following code that I wrote for you:
Sub main()
Dim celda As Range
Dim s_date As String
Dim s_time As String
Dim validate_date As String
Dim valid_date As String
Dim date_arr() As String
Dim rango As Range
Dim limit As Long
limit = Columns("B").Find("", Cells(Rows.Count, "B")).Row - 1
Set rango = ActiveSheet.Range("B2:B" & limit)
' works only for date values, another value would return non expected values
For Each celda In rango
validate_date = Left(celda.Value, 1)
If validate_date <> "" Then
If Not celda.Rows.Hidden Then
If validate_date <> "0" Then
s_date = Trim(Mid(celda.Value, 1, InStr(1, celda.Value, " ") - 1))
s_time = Trim(Mid(celda.Value, InStr(1, celda.Value, " "), Len(celda.Value) - InStr(1, celda.Value, " ")))
date_arr = Split(s_date, "/")
valid_date = date_arr(1)
valid_date = valid_date & "/0" & date_arr(0)
valid_date = valid_date & "/" & date_arr(2)
valid_date = valid_date & " " & s_time
celda.Offset(0, 1).Value = CDate(valid_date)
End If
End If
End If
Next celda
End Sub
In order to use this code you should insert one empty column to the right from target. Second, you should to select entire C column and run the macro.
Edit 1. Ok, this macro autoselect column B. Select column dates is not necessary now.
Excel has parsed the dates according to your Windows Regional Settings short date format. Those that it could not parse (where the month>12) it left as text. Since there was initially a difference between the date format in the text file, and the date format in your Windows Regional settings, it is likely that many of the dates that appear as dates (or as unformatted numbers) were converted incorrectly.
You have a few options:
Import the text file using the Get External Data tab From Text option on the Data Ribbon. This will open up the text import wizard and allow you to specify the date format of the data being imported.
Change your Windows Regional settings short date format to match that in the text file.
Those are probably the two simplest options. The first can be automated through VBA. The second, not so much.

Excel VBA importing .txt file results in wrong date format

I'm importing a text file (not .csv, a .txt) which is tab delimited. The first column contains dates, some are in dd/mm/yyyy format, others are in dd/mm/yyyy hh:mm:ss format.
When running the following code a few of the dates come out in mm/dd/yyyy format. There is nothing unusual about the ones that do, it appears to happen at random (some have the time, some dont but either way the source is still day-month-year)
Sub LQMTrend()
Dim fp, textLine As String
Dim iRow As Integer
Dim lineArr() As String
Dim ws As Worksheet
Set ws = Sheets("Data")
iRow = 1
fp = "//srv57data1\product_support\xChange\Beam Profile Image Tool\LQM Reviews\Log files\Log file.txt"
Open fp For Input As #1
Do Until EOF(1)
Line Input #1, textLine
lineArr = Split(textLine, vbTab)
For x = 0 To UBound(lineArr)
ws.Cells(iRow, x + 1) = lineArr(x)
Next x
iRow = iRow + 1
Loop
Close #1
I've tried declaring lineArr as a variant but it makes no difference. Any ideas?
Thanks
Edit: I appreciate this is similar to Excel VBA: importing CSV with dates as dd/mm/yyyy but the simplest answers are different in each case - for CSV files the 'use local date setting' import option solves the problem, this is not available when opening .txt files, the date must be converted on the fly using CDate or similar. Hope this helps clarify.
Excel first tries to convert a date string to the format of the local setting. If it fails, like when the month is superior to 12, it will then inverse the month and the days. Since you are dealing with the two types of formats, you best option is probably to parse the dates yourself:
Sub Macro1()
Dim arr() As String
Dim mydate As Date
' US format 6 may 2015
arr = Split("05/06/2015", "/")
mydate = DateSerial(Year:=arr(2), Month:=arr(0), Day:=arr(1))
' UK format 6 may 2015
arr = Split("06/05/2015", "/")
mydate = DateSerial(Year:=arr(2), Month:=arr(1), Day:=arr(0))
End Sub
As Assylias mentioned, some dates can be ambiguous. To Excel a date is nothing but a formatted number which represents the number of days since 01/01/1900, today (March 3, 2016) to excel is nothing more than 42447. When using the number, there can be no ambiguity about the date format.
I Suggest changing
ws.Cells(iRow, x + 1) = lineArr(x)
to
With ws.Cells(iRow, x + 1)
If x = 0 Then
.Value = CLng(CDate(lineArr(x)))
.NumberFormat = "mm/dd/yyyy;#"
Else
.Value = lineArr(x)
End If
End With
You need to convert your string date to a "real date" (serial number) before writing it to your worksheet. Here is one way to do that. Alter the array element to reflect the proper column in your original file.
'convert date to proper date before writing to worksheet
'Assuming date is in column 3
Dim DT As Date, TM As Date, V As Variant
V = Split(lineArr(2))
'is there a time segment
If UBound(V) = 1 Then
TM = TimeValue(V(1))
Else
TM = 0
End If
'convert the date segment to a real date
V = Split(V(0), "/")
DT = DateSerial(V(2), V(1), V(0)) + TM
'write it back to linearr
lineArr(2) = DT
You should change the date AFTER you do the import. A text file, like a CSV file, has no formatting whatsoever.

Ms Access 2007 queries returns Boolean values false when it should be true

This kind of hard to explain specially since english is not my first language, let's see if can make myself understand, im trying to perform a Select query to get the records within a time frame(column ContactDate contains the date/time values) the query is as follow:
SELECT Val([ACD_ID] & Format(DateValue([ContactDate]),'0')) AS SEARCH_CODE, CFinal, 1 AS Expr1,
COPCFCR, FCRPossible, RecordName
FROM [YTD-Daily_Report]
WHERE ((([YTD-Daily_Report].[ContactDate])>=#9/01/2014#
And ([YTD-Daily_Report].[ContactDate])<=#10/01/2014#));
In the source Table(YTD-Daily_Report) COPCFCR and FCRPossible are define as Checkboxes(true or false), when i run this query using Access within the database it all works well i get a column with the concatenated value of the ID + Date, a column containing the score, a column with a 1 in it, a column with the COPCFCR value(true or false), a column with the FCRPossible value(true or false), and column with the RecordName, at this point if i compared with the values on the table they match 100%.
Now, i took this query and put it on an Excel workbook but when it runs it returns the values for the columns COPCFCR and FCRPossible wrong, sometimes a false is returned as true or viceversa and other times the values match 100% with the corresponding values on the source table, for example in some rows COPCFCR is returned as true when it should be false according to the source table.
Here is the Excel VBA code I'm using:
Dim rsSource As New Recordset
Dim m_Connection As New Connection
Dim rngTarget as range
dim result as long
m_Connection.Provider = "Microsoft.ACE.OLEDB.12.0"
m_Connection.Open "Path and name of the Database"
strQuery = "SELECT Val([ACD_ID] & Format(DateValue([ContactDate]),'0')) AS SEARCH_CODE, CFinal, 1 AS Expr1, COPCFCR, FCRPossible, RecordName" & Chr(13) & _
"FROM [YTD-Daily_Report]" & Chr(13) & _
"WHERE ((([YTD-Daily_Report].[ContactDate])>=#" & Format(START_DATE, "m/dd/yyyy") & "# And ([YTD-Daily_Report].[ContactDate])<=#" & Format(STOP_DATE + 1, "m/dd/yyyy") & "#));"
rsSource.Open strQuery, m_Connection, adOpenForwardOnly, adLockReadOnly
Set rngTarget = Range("A2")
result = rngTarget.CopyFromRecordset(rsSource)
If rsSource.State Then rsSource.Close
Set rsSource = Nothing
If m_Connection.State Then m_Connection.Close
Set m_Connection = Nothing
Any ideas what could be happening?
It seems the database file was corrupted and this caused the data to be exported in a different way that it was call for. The query is working fine as it is.