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

Question

我正在从监视器手册中挖掘一些数据，一次有很多文件!

目前我已经测试了这个脚本和工作过喜欢 10 个文件 ，然后突然间，当用 测试时300+ 开始 给我

Error 5 (invalid procedure call or argument)

在这条线上
- 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 的原因。