Mauro Scattolini
Mauro Scattolini

Reputation: 23

Mine data from .txt to excel spreadsheet with vba script

I'm mining some data from monitor manuals, so lot of files at once!

At the moment I've tested this script and worked fine for like 10 files, then all of a sudden, when tested with 300+ started to gave me

Error 5 (invalid procedure call or argument)

on this line - ActiveSheet.Cells(i, 1) = Left(xFile.Name, InStrRev(xFile.Name, ".") - 20)

Still it properly record all the file name correctly, but not the array I've set up (but working with 10 files at a time). Tried few changes here and there but can't wrap my head around it. Disclaimer: I don't know much about VBA so most probably there are few other issues here and there! Thank you!

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

Upvotes: 2

Views: 154

Answers (1)

Vityata
Vityata

Reputation: 43575

Write the line where there is an error with a check:

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

The reason is that if the InStrRev returns a 0, then you pass -20 to the Left() argument and this is what gives error 5.

Upvotes: 1

Related Questions