从文件夹中的多个文本文件中提取数据到 Excel 工作表中

Question

我有多个与工作中的程序一起使用的“数据表”文本文件，需要从中获取值并将其全部合并到电子表格中。

文本文件的格式如下：

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

标签在所有文件中都是一致的，每行都以分号 [ ; ] 所以我假设这应该很容易。我需要将“DescText”、“VendCode”、“ProdType”、“MajRev”、“MinRev”和“ProdName”拉到单独的列中。

大约有 100 个单独的数据文件，每个都有一个无意义的文件名，所以我希望宏通过并打开文件夹中的每个文件。

Answer 1

感谢您的帮助，这是我针对这个特定问题提出的解决方案

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

Answer 2

我将如何解决完整的任务：

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

整个解决方案包含 3 个不同的程序：

• importFiles 读取给定目录的内容（必须作为参数传递），如果找到 .txt 文件，它会调用 readFile() 并将文件的完整路径传递给它

• readFile() 打开文本文件并将内容存储在字符串变量中。完成此操作后，它会为您感兴趣的每个值调用 getValue。

• getValue 分析给定内容并提取给定值。

只需调整 getValue() 的调用，以便获得所有感兴趣的值并存储它们，而不是通过 debug.print 显示并使用正确的目录调用第一个过程，如 importFiles "C:\Temp "