將多個文本文件導入並解析爲單個XLS？

Question

我一直在使用Google，但由於我沒有VBA技能，我無法找到任何可以正常工作的東西，並且我可以適應我的需求。

我有一個包含大約4500個文本文件的文件夾，並在我們處理的計算機上運行硬件測試的輸出。該文本文件有很多我不需要的信息。我所需要的是將所有這些文件導入到一個電子表格中，然後將它們分解爲3個所需的字段 - 並且以這種容易閱讀的方式。

我已經很難找到一個VBA宏，導入文本文件沒有錯誤，我不能過去。我確實找到了下面這個，但是它設置爲在文件中尋找第二列，在我的情況下，它將輸入的數據搞砸了，並且繞過各處的值（認爲次要格式化問題是4500條記錄）。

下面是宏：

Sub test() 
    Dim myDir As String, fn As String, ff As Integer, txt As String 
    Dim delim As String, n As Long, b(), flg As Boolean, x 
    myDir = "c:\test" '<- change to actual folder path 
    delim = vbTab '<- delimiter (assuming Tab delimited) 
    Redim b(1 To Rows.Count, 1 To 2) 
    fn = Dir(myDir & "\*.txt") 
    Do While fn <> "" 
    ff = FreeFile 
    Open myDir & "\" & fn For Input As #ff 
    Do While Not EOF(ff) 
     Line Input #ff, txt 
     x = Split(txt, delim) 
     n = n + 1 
     If Not flg Then b(n,2) = fn 
     If UBound(x) > 0 Then 
     b(n,1) = x(1) 
     End If 
     flg = True 
    Loop 
    Close #ff 
    flg = False 
    fn = Dir() 
    Loop 
    ThisWorkbooks.Sheets(1).Range("a1").Resize(n,2).Value = b 
End Sub 

這裏是文本文件的一個樣本：

ILPN Number: I01128204 
MAC Address: E0DB55820F85 

Hardware: 

CPU:Intel(R) Core(TM) i3-2370M CPU @ 2.40GHz 
MOTHERBOARD:Dell Inc. - 0G8TPV - A02 
BIOS VERSION/DATE:A02 - 08/15/2012 
RAM DETECTED:4096 MB (BANK 0: 0/DDR3/1333 - BANK 2: 0/Unknown/0) 
MANUFACTURER:Dell Inc. 
PRODUCT:Inspiron 3520 
SERIAL:B1JW9V1 
NIC SPEED/NAME:100 Mbps - Realtek PCIe FE Family Controller, V:8.1 
GRAPHIC RES:1366 x 768 (32 bits) 
OPTIC DRIVE:HL-DT-ST, DVD+-RW GT80N , A103 (E:) 
FIXED DISK:ST500LM012 HN-M500MBB - 465.76 GB (C: - GPT) 
- 0.00 GB (D: - MBR) 
WINPE:Microsoft Windows 8 Ultimate Edition, 32-bit (build 9200) 

Module 126: Result: Ok 

Initializing module version='1.0.0.17' with '' 
Module Initialization done. 
Starting module with: Param1=0x00010010 - Param2=0xFFFF0000 
Module start: 14/05/2013 10:38:40 
Set language module to: en-US 
    Found disk: 0 - 'ST500LM012 HN-M500MBB' 
All PHYSICALDRIVE will be used as valid target... 
Module started properly. 
Cleaning element 'Disk ID: 0 - Model: ST500LM012 HN-M500MBB - Size: 465.762 GB' with  algorithm 'Basic (random)'... 
Clean process Successful 
Process took 6099 sec to clean 476940.02MB ~ 78.20 MB/Sec 
Closing module with code '1'... 
Closing module done with result '0' 
Releasing module... 
Releasing module done at: 14/05/2013 12:20:19 

所以，從一切，我需要拉出「ILPN數「，MAC地址和說」模塊126：結果OK「的行。其他一切都可以消失。如果我可以使用三個值的列進行排序，然後將每條記錄放在其自己的行中，那將會很好。

這可能是一個兩步過程。其中一種或兩種解決方案都會非常有幫助。謝謝！

Answer 1

重述任務/問題：

給出一個文件夾中有很多結構化文本文件，提取每個文件中的三個（或者三的倍數？）數據項（ILPN號，MAC地址，測試結果）並將它們作爲行放入.txt/.csv文件中，該文件可以通過/導入到Excel中進行衝突。

點子：

遍歷所述文件，讀取每個入內存，解析/使用一個RegExp三重提取數據（一個或多個），並將其寫入到輸出文件中;使用Excel打開輸出文件，手動進行進一步的操作。

計劃：

使用一個VBScript命令行讓事情變得簡單。

[如果你看起來很好，你可以回答這個問題：「每個輸入文件是否包含一個或多個信息三元組？」，我願意爲這個概念添加一些概念驗證碼。

當你等待：

鑑於你額外的信息，我相信@安斯加爾的關於您的輸入數據的假設是正確的大多是和我固定的代碼的兩個錯別字。因此，通過啓動「命令提示符」，創建/更改到合適的目錄，將代碼複製到文件中 - 例如ansgar.vbs - ，讓文件夾/輸出文件規範適應您的需要，然後運行它通過cscript ansgar.vbs。

小的變化 - 就像把整個「模塊」行到第3項

If Left(line, 10) = "Module 126" Then 
    ws.Cells(row, 3).Value = Trim(Split(line, ":")(2)) 
==> 
If Left(line, 7) = "Module " Then 
    ws.Cells(row, 3).Value = line 

並不難。如果你很幸運，你的問題就解決了。

更新（WRT評論/標）：

我認爲的

ws.Cells(row, 3).Value = Trim(Split(line, ":")(2)) 

行是罪魁禍首。分割（）上的「：」應該分裂像

Module 126: Result: Ok 

輸入線成編號的三個要素「模塊126」，「結果」和「確定」的陣列/索引/從下標0到2。如果Split（）不會在行中得到兩個分隔符： 生成的數組較小，並且對元素＃2的訪問將失敗。

您必須將Split（）的返回值賦值給變量，檢查數組的大小（UBound），查看故障線路，並決定是忽略它們還是更改防護如果條件。

Answer 2

一個VBScript用於讀取多個輸入文件的三條線到一個Excel工作表看起來是這樣的：

Set xl = CreateObject("Excel.Application") 
xl.Visible = True 

Set wb = xl.Workbooks.Add 
Set ws = wb.Sheets(1) 

row = 1 
ws.Cells(row, 1).Value = "ILPN" 
ws.Cells(row, 2).Value = "MAC Address" 
ws.Cells(row, 3).Value = "Module 126" 

Set fso = CreateObject("Scripting.FileSystemObject") 
For Each f In fso.GetFolder("C:\your\folder").Files 
    If LCase(fso.GetExtensionName(f.Name)) = "txt" Then 
    row = row + 1 
    Set stream = f.OpenAsTextStream 
    ws.Cells(row, 1).Value = Trim(Split(stream.ReadLine, ":")(1)) 
    ws.Cells(row, 2).Value = Trim(Split(stream.ReadLine, ":")(1)) 
    Do Until stream.AtEndOfStream 
     line = stream.ReadLine 
     If Left(line, 10) = "Module 126" Then 
     ws.Cells(row, 3).Value = Trim(Split(line, ":")(2)) 
     Exit Do 
     End If 
    Loop 
    stream.Close 
    End If 
Next 

wb.SaveAs "C:\some\folder\output.xls", -4143, , , , False 
wb.Close 
xl.Quit 

作爲VBA宏下面應該工作：

Sub LoadDataFromFiles 
    row = 1 
    ActiveSheet.Cells(row, 1).Value = "ILPN" 
    ActiveSheet.Cells(row, 2).Value = "MAC Address" 
    ActiveSheet.Cells(row, 3).Value = "Module 126" 

    Set fso = CreateObject("Scripting.FileSystemObject") 
    For Each f In fso.GetFolder("C:\your\folder").Files 
    If LCase(fso.GetExtensionName(f.Name)) = "txt" Then 
     row = row + 1 
     Set stream = f.OpenAsTextStream 
     ActiveSheet.Cells(row, 1).Value = Trim(Split(stream.ReadLine, ":")(1)) 
     ActiveSheet.Cells(row, 2).Value = Trim(Split(stream.ReadLine, ":")(1)) 
     Do Until stream.AtEndOfStream 
     line = stream.ReadLine 
     If Left(line, 10) = "Module 126" Then 
      ActiveSheet.Cells(row, 3).Value = Trim(Split(line, ":")(2)) 
      Exit Do 
     End If 
     Loop 
     stream.Close 
    End If 
    Next 

    ActiveWorkbook.Save 
End Sub