将多个文本文件导入并解析为单个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