This is the next step in my project to query Companies House records. The first step, retrieving and validating the company numbers to be targeted, was covered here and I will include that code at the end for context.
In this stage, GetTargetFilenames
, I need to parse the entire series of Corporate Filings (typically 100,000 per month, going back 30 months at this point) and, for each:
- Extract the company number from the filename
- Check the company number against the ones I am targeting
- If it is being targeted, add it to a
Dictionary
of target filenames
With this project, I am trying to take particular care with regards to future maintainability (naming, commenting etc.), so any critiques of that aspect would be especially welcome.
Option Explicit
Public Const COMPANY_NUMBER_COLUMN As Long = 1
Public Const parentFolderPath As String = "S:\Investments\Data\Companies House\Monthly Companies House Downloads\"
Public Sub ParseAllCompanyRecords()
'/ Data Structure: "Company Numbers", once input, will be stored as strings
'/ Company Number: 8-character string, generally 8-digits but sometimes with text prefixes E.G. "OC374102"
'/ Folder Path for monthly CH downloads: "S:\Investments\Data\Companies House\Monthly Companies House Downloads\"
'/ Filename Strucutre of a Monthly Folder: [parentFolderPath]"Accounts_Monthly_Data-"[Full Month Name][yyyy]"\" - Square Brackets not in filename
'/ Filename Structure of an individual filing: [Monthly Folder Path]"Prod224_"[4-character code]"_"[8-character Company Registration Number]"_"[yyyymmdd][.html OR .xml] - Square Brackets not in filename
Dim targetCompanyNumbers As Dictionary
Set targetCompanyNumbers = GetTargetCompanyNumbers
Dim targetFilenames As Dictionary
Set targetFilenames = GetTargetFilenames(targetCompanyNumbers)
End Sub
Public Function GetTargetFilenames(ByRef targetCompanyNumbers As Dictionary) As Dictionary
'/ Folder Path for monthly CH downloads: "S:\Investments\Data\Companies House\Monthly Companies House Downloads\"
'/ Filename Strucutre of a Monthly Folder: [parentFolderPath]"Accounts_Monthly_Data-"[Full Month Name][yyyy]"\" - Square Brackets not in filename
'/ Filename Structure of an individual filing: [Monthly Folder Path]"Prod224_"[4-character code]"_"[8-character Company Registration Number]"_"[yyyymmdd][.html OR .xml] - Square Brackets not in filename
Dim targetFilenames As Dictionary
Set targetFilenames = New Dictionary
Const START_YEAR As Long = 2013
Const START_MONTH As Long = 9 '/ September
Dim iYear As Long
iYear = START_YEAR
Dim iMonth As Long
iMonth = START_MONTH
Dim currentYear As Long
currentYear = Year(Now)
Dim currentMonth As Long
currentMonth = Month(Now)
Dim monthFolderPath As String
Dim fileSpec As String
Dim fileList As Collection
Dim filename As String
Dim companyNumber As String
Dim isTarget As Boolean
Dim i As Long
Do While Not ((iYear = currentYear And iMonth > currentMonth) Or iYear > currentYear) '/ first condition will not catch where current Month is December, hence second condition
DoEvents '/ These folders are BIG, like 100,000 - 300,000 files and 5-15GB EACH big, so this may take a while and DoEvents is necessary
'/ Expected runtime, 30s-2m per month folder, typically 40s
Debug.Print "Year: " & iYear & " Month: " & iMonth & " Begin folder parse: " & Format(Now, "hh:mm:ss")
monthFolderPath = FolderPathFromMonthYear(iMonth, iYear)
fileSpec = monthFolderPath & "*"
Set fileList = GetFileList(fileSpec)
DoEvents
Debug.Print "Year: " & iYear & " Month: " & iMonth & " Filelist Retrieved: " & Format(Now, "hh:mm:ss")
For i = 1 To fileList.Count
If i Mod 8192 = 0 Then DoEvents
filename = fileList(i)
companyNumber = CompanyNumberFromFilename(filename)
isTarget = targetCompanyNumbers.Exists(companyNumber)
If isTarget And Not targetFilenames.Exists(filename) Then targetFilenames.Add filename, filename
Next i
DoEvents
Debug.Print "Year: " & iYear & " Month: " & iMonth & " End MonthLoop: " & Format(Now, "hh:mm:ss")
iMonth = iMonth + 1
If iMonth = 13 Then
iYear = iYear + 1
iMonth = iMonth - 12
End If
Loop
Set GetTargetFilenames = targetFilenames
End Function
Public Function FolderPathFromMonthYear(iMonth, iYear) As String
'/ Folder Path for monthly CH downloads: "S:\Investments\Data\Companies House\Monthly Companies House Downloads\"
'/ Filename Strucutre of a Monthly Folder: [parentFolderPath]"Accounts_Monthly_Data-"[Full Month Name][yyyy]"\" - Square Brackets not in filename
FolderPathFromMonthYear = parentFolderPath & "Accounts_Monthly_Data-" & MonthName(iMonth) & CStr(iYear) & "\"
End Function
Public Function CompanyNumberFromFilename(ByVal filename As String) As String
'/ Company Number: 8-character string, generally 8-digits but sometimes with text prefixes E.G. "OC374102"
'/ Filename Structure of an individual filing: [Monthly Folder Path]"Prod224_"[4-character code]"_"[8-character Company Registration Number]"_"[yyyymmdd][.html OR .xml] - Square Brackets not in filename
'/ Can only guarantee the structure of the final fileName section of the filePath, so will work from the end of the filename backwards
Dim indexFinalFullStop As Long
indexFinalFullStop = InStrRev(filename, ".") '/ returns final full stop in string
'/ End of filename structure: [8-character target number]"_"[yyyymmdd]"."[file extension]
'/ targetnumber starts 17 characters before the final full stop
Dim indexCompanyNumber As Long
indexCompanyNumber = indexFinalFullStop - 17
Dim companyNumber As String
companyNumber = Mid$(filename, indexCompanyNumber, 8)
CompanyNumberFromFilename = companyNumber
End Function
Function GetFileList(fileSpec As String) As Collection
Dim fileList As Collection
Set fileList = New Collection
Dim fullFilename As String
fullFilename = Dir(fileSpec)
Do While fullFilename <> ""
fileList.Add fullFilename
fullFilename = Dir()
Loop
Set GetFileList = fileList
End Function
GetTargetCompanyNumbers
provided for context if desired:
Public Function GetTargetCompanyNumbers() As Dictionary
Dim targetCompanyNumbers As Dictionary
Set targetCompanyNumbers = New Dictionary
Dim finalRow As Long, columnRange As Range
With wsInputs
finalRow = .Cells(.Rows.Count, COMPANY_NUMBER_COLUMN).End(xlUp).row
Set columnRange = .Range(.Cells(2, COMPANY_NUMBER_COLUMN), .Cells(finalRow, COMPANY_NUMBER_COLUMN))
End With
Dim columnArray As Variant
columnArray = columnRange
Dim LB1 As Long, UB1 As Long
AssignArrayBounds columnArray, LB1, UB1
Dim ix As Long
Dim elementValue As Variant
Dim companyNumber As String
For ix = LB1 To UB1
elementValue = columnArray(ix, 1)
companyNumber = CompanyNumberFromValue(elementValue)
If Not (targetCompanyNumbers.Exists(companyNumber) Or companyNumber = vbNullString) Then targetCompanyNumbers.Add companyNumber, companyNumber
Next ix
Set GetTargetCompanyNumbers = targetCompanyNumbers
End Function
Public Function CompanyNumberFromValue(ByVal vValue As Variant) As String
'/ Company Number: 8-character string, generally 8-digits but sometimes with text prefixes E.G. "OC374102"
Dim textValue As String
textValue = CStr(vValue)
Dim trimText As String
trimText = Trim$(textValue)
Dim companyNumber As String
If IsNumeric(trimText) Then
companyNumber = Format(trimText, "00000000") '/ Add back any leading zeroes that Excel may have stripped
ElseIf Len(trimText) = 8 Then
companyNumber = trimText
Else
'/ Not a number, not the correct number of characters. Invalid input.
companyNumber = vbNullString
End If
CompanyNumberFromValue = companyNumber
End Function
inStrRev
should be faster? I find the documentation not clear in that it will return the same number asinStr
- not the index number starting from the back. That could end up in confusion for someone. \$\endgroup\$InStrRev
will start at the end of the string and return the first match it finds.InStr
will do the same but from the start of the string. So, they will only be the same number if there is only one match in the string to find. MCVE here \$\endgroup\$.
in a file name, it might be better to useinstr
, but if there's not then there's really no way around it. \$\endgroup\$