ReDim Preserve raise error Subscript out of range - arrays

Question

Getting a
Run-time : Error No. 9
Subscript out of range
at the line:
ReDim Preserve aryFileNames(UBound(aryFileNames) - 1)
In the code below which is meant to convert text files to Excel files in a particular folder.
Sub ConvertTextFiles()
Dim fso As Object '<---FileSystemObject
Dim fol As Object '<---Folder
Dim fil As Object '<---File
Dim strPath As String
Dim aryFileNames As Variant
Dim i As Long
Dim wbText As Workbook
Application.ScreenUpdating = False
'// I am assuming the textfiles are in the same folder as the workbook with //
'// the code are. //
strPath = ThisWorkbook.Path & Application.PathSeparator
'// Set a reference to the folder using FSO, so we can use the Files collection.//
Set fso = CreateObject("Scripting.FileSystemObject")
Set fol = fso.GetFolder(strPath)
'// Using FSO's Files collection, we'll run through and build an array of //
'// textfile names that exist in the folder. //
ReDim aryFileNames(0)
For Each fil In fol.Files
If fil.Type = "Text Document" Then
'// If correct Type (a text file), we'll assign the name of the found //
'// textfile to the last element in the array - then add an empty //
'// element to the array for next loop around... //
aryFileNames(UBound(aryFileNames)) = fil.Name
ReDim Preserve aryFileNames(UBound(aryFileNames) + 1)
End If
Next
'// ... now since we were adding an empty element to the array, that means we'll//
'// have an emmpty ending element after the above loop - get rid of it here. //
ReDim Preserve aryFileNames(UBound(aryFileNames) - 1)
'// Basically, For Each element in the array... //
For i = LBound(aryFileNames) To UBound(aryFileNames)
'// ...open the textfile, set a reference to it, SaveAs and Close. //
Workbooks.OpenText Filename:=strPath & aryFileNames(i), _
Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), _
Array(7, 1), _
Array(55, 1), _
Array(68, 1))
Set wbText = ActiveWorkbook
wbText.Worksheets(1).Columns("A:D").EntireColumn.AutoFit
wbText.SaveAs Filename:=strPath & Left(aryFileNames(i), Len(aryFileNames(i)) - 4), _
FileFormat:=xlWorkbookNormal
wbText.Close
Next
Application.ScreenUpdating = True
End Sub

Answer 1

You'll get a subscript out of range any time your For Each loop doesn't execute or you don't find any text documents. The starting bound of the array is 0 and in that case it never gets incremented, so this line of code...
ReDim Preserve aryFileNames(UBound(aryFileNames) - 1)
...is trying to size the array to a bound of -1. Since you're working with strings, you can take advantage of a quirk in the Split function to simplify your array sizing. If you Split a vbNullString, VBA will return a String array with a UBound of -1. Instead of initializing it with ...
ReDim aryFileNames(0)
... and then trimming it afterward, you can just do this:
aryFileNames = Split(vbNullString)
'UBound of the array is now -1.
For Each fil In fol.Files
If fil.Type = "Text Document" Then
ReDim Preserve aryFileNames(UBound(aryFileNames) + 1)
aryFileNames(UBound(aryFileNames)) = fil.Name
End If
Next
'Array is correct size - you can skip "trimming" it.
'ReDim Preserve aryFileNames(UBound(aryFileNames) - 1)