从文件夹中的所有文本文件读取，检查匹配，并将文本文件的值插入到Excel工作表中

我正在尝试工作的代码，这将允许我检查文件夹中的所有文本文件的两行。

每个文本文件的结构都是这样的：

NS1234 <--- A random reference number on the first line Approve < Reject or Approve on the second line 

目前代码只读取一个文本文件，我指定的名称，但是我希望它扫描所有.txt文件。

接下来，当我打开我的电子表格，我将有以下设置：

 Column A Column NS1234 

我想我的代码扫描所有的文本文件来检查列A中的所有文本文件的匹配参考号码。

然后在find匹配的地方，在文本文件的第二行写入“批准”或“拒绝”，插入列s中相应的行

码：

 Public Sub test() Dim fn As Integer fn = FreeFile Open "Z:\NS\Approval\NS32D1QR.txt" For Input As fn Dim wholeFile As String wholeFile = Input(LOF(fn), #fn) Close #fn Dim splitArray splitArray = Split(wholeFile, vbCrLf) Dim lineNum As Integer lineNum = 2 Dim i As Integer, intValueToFind As Integer intValueToFind = NS32D1QR For i = 1 To 500 ' Revise the 500 to include all of your values If Cells(i, 1).Value = intValueToFind And splitArray(lineNum - 1) = "Approve" Then Range("S" & ActiveCell.Row).Value = "Approve" End If Next i End Sub 

Answer 1

我不确定你在循环中做的testing，但是在我看来，在第一行的第一行没有用到循环或者在那里使用特殊variables的信息。 让我知道如果这个工作正常与否！ ;）

这里是一个testing的子，因为它是一个函数，你可以循环它或在Excel工作簿中使用它。

 Sub test() With Sheets("Sheet1") For i = 2 To .Rows(.Rows.Count).End(xlUp).Row .Cells(i, "S") = Get_AorP(.Cells(i, "A")) Next i End With End Sub 

这是你想要做的，转换为一个函数：

  Public Function Get_AorP(ByVal Value_to_Find As String) As String Dim fn As Integer, _ Txts_Folder_Path As String, _ File_Name As String, _ wholeFile As String, _ splitArray() As String, _ i As Integer On Error GoTo ErrHandler Txts_Folder_Path = "Z:\NS\Approval\" File_Name = Dir(Txts_Folder_Path & "*.txt") While File_Name <> vbNullString fn = FreeFile Open Txts_Folder_Path & File_Name For Input As fn wholeFile = Input(LOF(fn), #fn) Close #fn MsgBox File_Name splitArray = Split(wholeFile, vbCrLf) If UBound(splitArray) < 2 Or LBound(splitArray) > 1 Then 'avoid empty text files Else If InStr(1, splitArray(0), Value_to_Find) <> 0 Then If InStr(1, splitArray(1), "Approve") Then Get_AorP = "Approve" Exit Function Else If InStr(1, splitArray(1), "Reject") Then Get_AorP = "Reject" Exit Function Else 'Nothing to do End If End If Else 'not the good value End If End If File_Name = Dir() Wend Get_AorP = "No matches found" Exit Function ErrHandler: Get_AorP = "Error during the import." & vbCrLf & Err.Number & " : " & Err.Description End Function