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

时间:2015-06-02 07:40:53

标签: excel vba text-files

我正在尝试使用一个代码,这个代码可以让我检查文件夹中所有文本文件的两行。

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

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

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

接下来,当我打开电子表格时,我将进行以下设置:

Column A     Column
NS1234 

我希望我的代码扫描所有文本文件,以检查A列中与所有文本文件相关的任何匹配参考号。

然后在找到匹配项的位置插入&#39;批准&#39;或者&#39;拒绝&#39;,将其写在文本文件的第二行,写入列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

1 个答案:

答案 0 :(得分:0)

我不确定你在循环中进行的测试,但在我看来,2个第一行的信息在循环或使用特殊变量时没有用处。让我知道这项工作是否正常! ;)

这是一个测试子,因为它是一个函数,你可以循环它或在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