# Parsing 4 Million Filenames

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 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"

'/ 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
'/ 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
'/ 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

• My assumption is that inStrRev should be faster? I find the documentation not clear in that it will return the same number as inStr - not the index number starting from the back. That could end up in confusion for someone. – Raystafarian Apr 21 '16 at 16:55
• @Raystafarian not quite. 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 – Kaz Apr 21 '16 at 17:17
• Blocked by my work's firewall. Like I said, the documentation is unclear. So if there's only one . in a file name, it might be better to use instr, but if there's not then there's really no way around it. – Raystafarian Apr 21 '16 at 17:21
• A) I want the full stop at the end of the filename, so InStrRev is going to be faster anyway and B) Using "." in folder names is perfectly valid in Windows, so I can't assume that there won't be any – Kaz Apr 21 '16 at 17:23

To improve the performance, you should list the files in an Array instead of a Collection. I would also drop the unnecessary * for the file expression:

Sub GetFileList(folder As String, outList() As String)
Dim fname\$, count&
ReDim outList(0 To 10000)  ' set initial array size

fname = FileSystem.Dir(folder, vbNormal)
Do While Len(fname)

' double the size of the array if necessary
If count > UBound(outList) Then ReDim Preserve outList(0 To UBound(outList) * 2)

' insert the file path
outList(count) = fname
count = count + 1

' next file
fname = FileSystem.Dir()
Loop

' set the final size for the array
If count Then
ReDim Preserve outList(0 To count - 1)
Else
outList = Split(Empty)  ' set an empty array
End If
End Sub

Public Function GetTargetFilenames(ByRef targetCompanyNumbers As Dictionary) As Dictionary
...

Dim fileList() As String
GetFileList monthFolderPath, fileList

For i = LBound(fileList) To UBound(fileList)
...
Next

End Function

• Good points and wow, I haven't seen type hints in a looong time. – Kaz May 5 '16 at 8:09

Everything looks pretty solid.

Dim fileSpec as String


I think this could be named better - I'm not sure what it is unless it's specifications?

Do While Not ((iYear = currentYear And iMonth > currentMonth) Or (iYear > currentYear))


I'd add the extra set of parenthesis just to make it more clear that it says not this or not this rather than not this or is that

Changing the iteration of iMonth to sit inside the if will save you one line of code. Also why subtract 12 from a known 13, just put it back at 1.

    If iMonth = 12 Then
iYear = iYear + 1
iMonth = 1
Else: iMonth = iMonth + 1