How to have VB Script read multiple files to extract data

[r_john]

I am currently using the VB code below to read a single file (.cfg format) and extract required data and have this data placed into separate columns using headings: DESCRIPTION | SPEED | SERVICE NUM. Sample format of this output in Excel is also shown.

Private Sub CommandButton1_Click()
Dim myFile As String, find1 As String, i As Integer, und As String, speed2 As Integer, text As String, Desc As String, r As Long, dashpos As Long, m As Long, textline As String, strLeft As String, strFind As String, strRight As String, strMid As String, speed As String
Dim regex As Object

'place source location of text file her
myFile = "C:\Users\username\Desktop\rand\1009.cfg"

Open myFile For Input As #1

Do Until EOF(1)
    Line Input #1, textline
    text = text & textline & vbCrLf
Loop

Close #1
Set regex = CreateObject("VBScript.RegExp")

    Range("A1").Value = "Description"
    Range("B1").Value = "Speed"
    Range("c1").Value = "Service Num"

    With regex
        .Global = True
        .MultiLine = False
        .IgnoreCase = False
        .Pattern = "description (.*?)[_ ](\d+M)[ _]((WDC)?\d{7})"
    End With
    Set Matches = regex.Execute(text)
    
    For Each mtch In Matches
        Range("A2").Offset(Idx) = mtch.submatches(0)
        Range("A2").Offset(Idx, 1) = mtch.submatches(1)
        Range("A2").Offset(Idx, 2) = mtch.submatches(2)
        Idx = Idx + 1
    Next

    Set regex = Nothing
   
    End Sub

Sample output of Excel after running script:

DESCRIPTION	SPEED	SERVICE NUM
COMPANY_NAME1	20M	5552154
COMPANY_NAME2	10M	2214114
COMPANY_NAME3	50M	4451121

The issue I am having is that there are multiple .cfg files that I have to extract data from, so having to run the VB code manually for EACH file is really tedious. Is there a way to run the script in Excel and have ALL the .cfg files in the directory be read and have the required data extracted and placed into a SINGLE Excel sheet in one go after running the VB script once?

The .cfg files can be renamed consecutively and placed into a single directory, for example. 1.cfg, 2.cfg, 3.cfg. etc...

Any assistance appreciated, thanks.

 

[GWteB]

Renaming your CFG files is not really necessary. I have not tested your original code and thus left it largely intact. In contrast, the code has been split into two procedures, and one more procedure has been added to collect all file names ending in .cfg.
This goes in the module of the worksheet or userform where your button is:

Private Sub CommandButton1_Click()

    Const cFolder   As String = "C:\Users\username\Desktop\rand\"   ' <<<< change accordingly

    Dim arrFiles    As Variant
    Dim sFullName   As Variant
    Dim Idx         As Long

    arrFiles = GetFiles_Cfg(cFolder)

    If Not IsEmpty(arrFiles(0)) Then
        For Each sFullName In arrFiles
            sFullName = cFolder & sFullName
            Call GetDataFrom_CFG(sFullName, Idx)
            DoEvents
        Next
    End If
End Sub

This goes in a standard module:

Public Sub GetDataFrom_CFG(ByVal argFileFullName As String, ByRef Idx As Long)
    
    Dim myFile As String, find1 As String, i As Integer, und As String, speed2 As Integer, text As String, Desc As String, r As Long, dashpos As Long, m As Long
    Dim textline As String, strLeft As String, strFind As String, strRight As String, strMid As String, speed As String
    Dim regex As Object

    Open argFileFullName For Input As #1

    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline & vbCrLf
    Loop

    Close #1
    Set regex = CreateObject("VBScript.RegExp")

    Range("A1").Value = "Description"
    Range("B1").Value = "Speed"
    Range("c1").Value = "Service Num"

    With regex
        .Global = True
        .MultiLine = False
        .IgnoreCase = False
        .Pattern = "description (.*?)[_ ](\d+M)[ _]((WDC)?\d{7})"
    End With
    Set Matches = regex.Execute(text)

    For Each mtch In Matches
        Range("A2").Offset(Idx) = mtch.submatches(0)
        Range("A2").Offset(Idx, 1) = mtch.submatches(1)
        Range("A2").Offset(Idx, 2) = mtch.submatches(2)
        Idx = Idx + 1
    Next

    Set regex = Nothing

End Sub


Public Function GetFiles_Cfg(ByVal argFolder As String) As Variant
    Dim fso         As Object
    Dim oFiles      As Object
    Dim oFile       As Object
    Dim arrTmp()    As Variant
    Dim i           As Long
    
    ReDim Preserve arrTmp(0)
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FolderExists(argFolder) Then
        Set oFiles = fso.GetFolder(argFolder)
        For Each oFile In oFiles.Files
            If StrComp(Right(oFile.Name, 4), ".cfg", vbTextCompare) = 0 Then
                ReDim Preserve arrTmp(i)
                arrTmp(i) = oFile.Name
                i = i + 1
            End If
        Next oFile
        Set oFiles = Nothing
    End If
    GetFiles_Cfg = arrTmp
    Set fso = Nothing
End Function