Option Explicit
Dim FileNum As Integer
Dim ReadStr As String
Dim ErrMsg As String
Dim ComLngFilename As String
Dim ComShtFileName As String
Dim ComDir As String
Dim WorkDir As String
Dim FileListArr() As String
Dim DirListArr() As String
Dim CharNo As Integer
Dim FileCount As Integer
Sub GetCommonFile()
'========================================================
'Open data file and read
'========================================================
'Get next available file handle number.
FileNum = FreeFile()
WorkDir = "C:\WorkFolder\"
ComLngFilename = "FilenameList.txt"
FileCount = 0
ReDim Preserve FileListArr(FileCount)
ReDim Preserve DirListArr(FileCount)
'Set error trap in case of fault with data file.
On Error GoTo ErrorCheck
ErrMsg = "An error has occured in opening common list file."
'Open text file for input.
Open WorkDir & ComLngFilename For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL]
'Close error trap.
On Error GoTo 0
On Error GoTo CloseFile
'Loop until the end of file is reached.
Application.StatusBar = "Importing file " & ComLngFilename & " . . . ."
Do While Seek(FileNum) <= LOF(FileNum)
'Store one line of text from file to variable.
Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , ReadStr
If ReadStr <> "" Then
For CharNo = Len(ReadStr) To 1 Step -1
If Mid(ReadStr, CharNo, 1) = "" Then
ComLngFilename = Right(ReadStr, Len(ReadStr) - CharNo)
ComShtFileName = Left(ComLngFilename, Len(ComLngFilename) - 4)
ComDir = Left(ReadStr, Len(ReadStr) - Len(ComLngFilename))
Exit For
End If
Next CharNo
End If
'store files
DirListArr(FileCount) = ComDir
FileListArr(FileCount) = ComLngFilename
FileCount = FileCount + 1
ReDim Preserve DirListArr(FileCount)
ReDim Preserve FileListArr(FileCount)
Loop 'Loop processing till eof.
'load listbox
ActiveWorkbook.Sheets("Sheet1").ListBox1.List = Application.Transpose(FileListArr)
CloseFile:
'Close the open text file.
Close
Exit Sub
ErrorCheck:
MsgBox ErrMsg, vbCritical, ThisWorkbook.Name
Exit Sub
End Sub