从.txt文件的文件夹中提取单行数据到excel

Question

我真的希望我能得到你的帮助。 我一直在寻找可能是一个简单的解决方案的高低。

我们有数百个与 cnc 程序相关的 txt 文件。不幸的是，在为零件和操作保持严格的编号系统方面一直缺乏控制。

我必须将每个文件中的第 3 行和第 4 行 txt 提取到一个 excel 文档中，以便我们可以支付一些报酬并将所有内容编目以供参考。

到目前为止，我发现的最接近我所追求的东西是在线程中

Extract a single line of data from numerous text files and import into Excel

但是我无法让它发挥作用——我的 excel 知识很好，但不能使用宏。 每个txt文件的开头都是

#1 <blank line>
#2 %
#3 O00000 (part description)
#4 (part descriptio)
#5 rest of program.

。 . . 根据要求，我包含了我要修改的代码。

Private Sub CommandButton1_Click()
    Dim filename As String, nextrow As Long, MyFolder As String
    Dim MyFile As String, text As String, textline As String, prog As String

    MyFolder = "M:\CNC Programs\Haas lathe programs\Haas ST30 programs\Programs\Programs in .txt format"
    MyFile = Dir(MyFolder & "*.txt")

    Do While MyFile <> ""
        Open (MyFolder & MyFile) For Input As #1
        Do Until EOF(1)
            Line Input #3, textline
            text = text & textline 
        Loop
        Close #1
        MyFile = Dir()
        Debug.Print text
        nextrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row + 1
        Sheet1.Cells(nextrow, "A").Value = Mid(text, prog)
        text = "" 'reset text
    Loop
End Sub

Answer 1

由于您对 vba 没有太多经验，这里有一些您可能想用谷歌搜索并将结果放在一起的点

• 在 Excel VBA 中打开一个文本文件（您应该从它开始，然后尝试读取一个文件）
• 使用 Excel VBA 遍历某个文件夹中的所有文件

您的代码需要执行以下操作。

• 获取您要加载的所有文件的列表
• 打开该列表中的每个文件
• 从该文件中读取第 3 行和第 4 行
• 将行复制到 Excel。

互联网上有很多例子，一旦你学会了如何搜索

Answer 2

几个小时后，在朋友的帮助下，我们想出了这个，或多或少地满足了我的需要。

我知道我想如何改进它，我现在只需要弄清楚。同样，我确信这是一个简单的技巧。坚持！！！

如果可以的话，我现在要做的就是拿走我的目录
'M:\CNC Programs\Haas Mills 程序\All Mill Programs .txt 格式\' 并扫描所有后续文件夹以查找所述 .txt 文件并将相同的信息提取到工作簿中。

如果我弄明白了，我会再次更新帖子。 感谢 832 先生让我走上正确的道路。

Private Sub CommandButton1_Click()
  Dim MyMask As String, nextrow As Long, MyFolder As String
  Dim MyFile As String, text As String, textline As String
  Dim posCommentStart As String, posCommentFinish
  Dim iLine As Integer

MyFolder = "M:\CNC Programs\Haas Mills programs\All Mill Programs .txt format\HAAS MINI-MILL BALLPADS & BALLPINS\"
MyMask = MyFolder & "*.txt"
MyFile = Dir(MyMask)

Do While MyFile <> ""
    iLine = 0
    Open (MyFolder & MyFile) For Input As #1
    Do Until EOF(1) Or iLine >= 4
        iLine = iLine + 1
        Line Input #1, textline
        If iLine >= 3 Then
           text = text & textline 'second loop text is already stored -> see reset text
        End If

    Loop
    Close #1
    MyFile = Dir()
    Debug.Print text

    posCommentStart = InStr(text, "(")
    posCommentFinish = InStr(text, ")")

    If posCommentStart > 0 Then

        nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

        ActiveSheet.Cells(nextrow, "A").Value = Left(text, posCommentStart - 2)
        ActiveSheet.Cells(nextrow, "B").Value = Mid(text, posCommentStart +        1, posCommentFinish - posCommentStart - 1)

    End If

    text = "" 'reset text

Loop
End Sub