從文件夾中的多個文本文件中提取數據到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”）調用第一個過程