[英]Read from all text files in folder, check for matches and insert text file value into Excel sheet
I am attempting to work on a code which will allow me to check two lines of all my text files in a folder. 我正在尝试使用一个代码,该代码将允许我检查文件夹中所有文本文件的两行。
Each text file will be structured like so: 每个文本文件的结构如下:
NS1234 <--- A random reference number on the first line
Approve < Reject or Approve on the second line
At the moment the code only reads one text file which I specify the name of, however I want it to scan all .txt files. 目前,代码仅读取一个我指定了名称的文本文件,但是我希望它扫描所有.txt文件。
Next, When I open my spread sheet I will have the following set-up: 接下来,当我打开电子表格时,我将进行以下设置:
Column A Column
NS1234
I want my code to scan all text files to check for any matching reference number from column A against all the text files. 我希望我的代码扫描所有文本文件,以针对所有文本文件检查A列中是否有任何匹配的参考号。
And then where a match is found insert either 'Approve' or 'Reject', where this is written on the second line of the text file, into the corresponding row in column s 然后在找到匹配项的地方,将“ Approve”或“ Reject”(写在文本文件的第二行)插入到s列中的相应行中
Code: 码:
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
i 'm not sure about the test that you made in your loop but it seems to me that the info where on the 2 first lines so no use to loop or to use special variables there. 我不确定您在循环中进行的测试,但是在我看来,信息在第一行的第二行中,因此没有用到循环或在其中使用特殊变量。 Let me know if this work properly or not!
让我知道这是否正常! ;)
;)
Here is a sub to test, as it is a function you can either loop on it or use it in Excel workbook. 这是一个要测试的子项,因为它是一个函数,您可以在其上循环或在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
Here is what you wanted to do, converted to a function : 这是您想要做的,转换为一个函数:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.