Reputation: 23
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
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