extract data from multiple text files in a folder into excel worksheet

Question

I have multiple "datasheet" text files that are used with a program at work and need to harvest values from them and combine it all into a spreadsheet.

The text files are formatted as such:

[File]
    DescText = "1756-IF16H 16 Channel Hart Analog Input Module";
    CreateDate = 04-07-10;
    CreateTime = 10:29;
    Revision = 1.1; 
    HomeURL = "http://www.ab.com/networks/eds/XX/0001000A00A30100.eds";

[Device]
    VendCode = 1;
    VendName = "Allen-Bradley";
    ProdType = 10;
    ProdTypeStr = "Multi-Channel Analog I/O with HART";
    ProdCode = 163;
    MajRev = 1;
    MinRev = 1;
    ProdName = "1756-IF16H/A";
    Catalog = "1756-IF16H/A";
    Icon = "io_brown.ico";

The Tags are consistent through all the files and each lines ends with a semicolon [ ; ] so I'm assuming this should be pretty easy. I need to pull "DescText","VendCode","ProdType","MajRev","MinRev",and"ProdName" into separate columns.

There are about 100 individual data files, each with a nonsensical filename, so I'm looking to have the macro just go through and open each one in the folder.

score 1 · Answer 1 · answered Oct 28 '14 at 15:37

Thanks for the help, here is the solution I came up with for this specific problem

Sub OpenFiles()

Dim MyFolder As String
Dim MyFile As String

MyFolder = "[directory of files]"
MyFile = Dir(MyFolder & "\*.txt") 
Dim filename As String
Dim currentrow As Integer: currentrow = 2


    Do While Myfile <> ""  'This will go through all files in the directory, "Dir() returns an empty string at the end of the list
    'For i = 1 To 500   'this was my debug loop to only go through the first 500 files at first

        filename = MyFolder & "\" & MyFile  'concatinates directory and filename

        Open filename For Input As #1 

        Do Until EOF(1)  'reads the file Line by line
            Line Input #1, textline  
            'Text = Text & textline
            If textline = "" Then  'error handler, if line was empty, ignore
            Else
                Dim splitline() As String
                splitline() = Split(textline, "=", -1, vbTextCompare) 
'because of how my specific text was formatted, this splits the line into 2 strings.  The Tag is in the first element, the data in the second

                If IsError(splitline(0)) Then
                    splitline(0) = ""
                End If

                Select Case Trim(splitline(0)) 'removes whitespace
                Case "DescText"
                    currentrow = currentrow + 1 
'files that didn't have a description row, resulted in empty rows in the spreadsheet.
                    ActiveSheet.Range("A" & currentrow).Cells(1, 1).Value = splitline(1)

                Case "Revision"
                    ActiveSheet.Range("B" & currentrow).Cells(1, 1).Value = splitline(1)
                 Case "ProdCode"
                    ActiveSheet.Range("C" & currentrow).Cells(1, 1).Value = splitline(1)
                 Case "ProdType"
                    ActiveSheet.Range("D" & currentrow).Cells(1, 1).Value = splitline(1)

                '...etc. etc... so on for each "tag"
                End Select
            End If
        Loop

        Close #1


        MyFile = Dir()  'reads filename of next file in directory
        'currentrow = currentrow + 1


    'Next i
    Loop

End Sub

cboden · Answer 2 · 2014-10-28T16:33:38.823

here how I would solve the complete task:

Private Sub importFiles(ByVal pFolder As String)
    ' create FSO
    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")

    ' create folder
    Dim oFolder As Object
    Set oFolder = oFSO.getFolder(pFolder)

    ' go thru the folder
    Dim oFile As Object
    For Each oFile In oFolder.Files
        ' check if is a text file
        If UCase(Right(oFile.Name, 4)) = ".TXT" Then
            Debug.Print "process file: " & oFolder.Path & "\" & oFile.Name
            readFile oFolder.Path & "\" & oFile.Name
        End If
    Next

    ' clean up
    Set oFolder = Nothing
    Set oFSO = Nothing
End Sub

Private Sub readFile(ByVal pFile As String)
    ' get new file handle
    Dim hnd As Integer
    hnd = FreeFile

    ' open file
    Open pFile For Input As hnd

    Dim sContent As String
    Dim sLine As String

    ' read file
    Do Until EOF(hnd)
        Line Input #hnd, sLine
        sContent = sContent & sLine
    Loop

    ' close file
    Close hnd

    ' extract requiered data
    Debug.Print getValue(sContent, "ProdName")
    Debug.Print getValue(sContent, "DescText")
End Sub

Private Function getValue(ByVal pContent As String, ByVal pValueName As String) As String
    Dim sRet As String

    sRet = ""
    If InStr(pContent, pValueName) Then
        pContent = Mid(pContent, InStr(pContent, pValueName) + Len(pValueName) + 2)
        sRet = Left(pContent, InStr(pContent, ";") - 1)
        sRet = Trim(sRet)
    End If

    getValue = sRet
End Function

Overall the solution contains 3 different procedures:

importFiles reads the content of a given directory (which has to be handed over as parameter) and if it finds a .txt file it calls readFile() and passes the full path of the file to it
readFile() opens the text file and stores the content in a string variable. After this is done it calles getValue for each value you are interessted in.
getValue analyses the given content and extractes the given value.

Simply adjust the calls of getValue() so that you get all values you are interessted in and store them instead of showing via debug.print and call the first procedure with the right directory like importFiles "C:\Temp"

extract data from multiple text files in a folder into excel worksheet

2 Answers2

Linked