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

后端 未结 2 1503
半阙折子戏
半阙折子戏 2020-12-22 09:48

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 fi

相关标签:
2条回答
  • 2020-12-22 10:30

    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
    
    0 讨论(0)
  • 2020-12-22 10:39

    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"

    0 讨论(0)
提交回复
热议问题