使用vba脚本将数据从.txt挖掘到excel电子表格

Question

我正在从监控手册中挖掘一些数据，这样就可以同时获得大量文件！

目前我已经测试了这个脚本并且工作很好用于 10个文件，然后突然间，在 300+开始测试< / strong>给了我

  

错误5（程序调用或参数无效）

就行了 - ActiveSheet.Cells(i, 1) = Left(xFile.Name, InStrRev(xFile.Name, ".") - 20)

仍然正确记录所有文件名，但不是我设置的数组（但一次只能处理10个文件）。 在这里和那里尝试了一些变化，但无法绕过它。 免责声明：我对VBA了解不多，所以很可能在这里和那里几乎没有其他问题！谢谢！

Sub ParseFiles()

Dim Data()  As Byte
Dim File    As Variant
Dim Files   As Variant
Dim Folder  As Object
Dim Line    As Variant
Dim Lines   As Variant
Dim key     As Variant
Dim Keys    As Variant
Dim n       As Long
Dim Path    As Variant
Dim Rng     As Range
Dim s       As Long
Dim Text    As String
Dim Wks     As Worksheet
Dim x       As Long
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xFiDialog As FileDialog
Dim xPath As String
Dim i As Integer



    ' Strings to search for in the text.
    Keys = Array("VESA mounting holes")


    ' Select Folder path of the text files to be parsed.
  With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Path = .SelectedItems(1)
        Else
            Exit Sub
        End If
 End With

    ' To use a fixed folder path, delete the With ... End With lines above.
    ' Remove the comment (single quote) from the line below. Change the path to your files.
    Path = "Z:\dell"

    Set Wks = ActiveSheet
    Set Rng = Wks.Range("B2")

    ' Clear any previous parsed text.


        ' Open the folder using it's path.
        With CreateObject("Shell.Application")
            Set Folder = .Namespace(Path)
        End With

        ' Check that the folder exists.
        If Folder Is Nothing Then
            MsgBox Path & " Not Found.", vbExclamation
            Exit Sub
        End If

        ' Return all files, links, and folders in the folder.
        Set Files = Folder.Items

        ' Filter out only text files.
        Files.Filter 64, "*.txt;*.csv"

        Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
If xFiDialog.Show = -1 Then
    xPath = xFiDialog.SelectedItems(1)
End If
Set xFiDialog = Nothing
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.GetFolder(xPath)
ActiveSheet.Cells(1, 1) = "File name"
i = 1
For Each xFile In xFolder.Files
    i = i + 1
    ActiveSheet.Cells(i, 1) = Left(xFile.Name, InStrRev(xFile.Name, ".") - 20)
Next


            ' Step through each text file in the folder.
            For Each File In Files
               ' Read all of the text into a byte array.
                Open File.Path For Binary Access Read As #1
                    ReDim Data(LOF(1))
                    Get #1, , Data
                Close #1

                ' Convert the byte array to a text string.
                Text = StrConv(Data, vbUnicode)

                ' Divide the text into individual lines using the carriage return and line feed characters.
                Lines = Split(Text, vbCrLf)

                ' Step through each line of text.
                For x = 0 To UBound(Lines)
                    ' Remove any leading or trailing spaces.
                    Line = Trim(Lines(x))

                    ' Search the line if it is not blank.
                    If Line <> "" Then
                        ' Check the line for each search term or key.
                        For Each key In Keys
                            ' Get key's position in the text line.
                            s = InStr(1, Line, key)

                            ' If the key is found and is not just the key then paste the text after the key.
                            If s > 0 And s + Len(key) < Len(Line) Then
                                Rng.Offset(0, n).Value = "yes"
                                n = n + 1
                                Else
                                Rng.Offset(0, n).Value = "no"
                            End If

                            ' Have all the keys been found? There are only 3 per file.
                            If n > UBound(Keys) Then GoTo NextFile
                        Next key
                    End If
                Next x
 NextFile:
                ' Reset the column counter.
                n = 0
                ' Advance to the next row on the worksheet.
                Set Rng = Rng.Offset(1, 0)
            Next File

 End Sub

Answer 1

使用支票写出错误的行：

If InStrRev(xFile.Name, ".") >= 20 Then 
   ActiveSheet.Cells(i, 1) = Left(xFile.Name, InStrRev(xFile.Name, ".") - 20)
End If

原因是如果InStrRev返回0，那么您将-20传递给Left()参数，这就是错误5的原因。