Option Explicit
Sub subHLinkFiles()
' Assume files exist.
' Create two filename arrays.
' One array will have just the file names.
' The other will have the full path.
Dim slFullFileNames() As String
Dim slFileNames() As String
ReDim Preserve slFullFileNames(0)
ReDim Preserve slFileNames(0)
' This is a record of the Top file and the file type looked for.
slFullFileNames(0) = "C:\Users\Talāt\Desktop\INVARCHIVE\"
slFileNames(0) = "XLS"
subGetFileNames _
slFullFileNames(), _
slFileNames()
Stop
' *********************************************************************
End Sub
Sub subGetFileNames( _
spFullFileNames() As String, _
spFileNames() As String)
Dim flslFile As File
Dim flslFiles As Files
Dim follFolder As Folder
Dim follSubFolder As Folder
Dim olFS As FileSystemObject
Dim slExt As String
Dim slFile As String
Dim slFileName As String
Dim slFolder As String
Dim slShortFileName As String
slFolder = spFullFileNames(0)
Set olFS = CreateObject("Scripting.FileSystemObject")
Set follFolder = olFS.GetFolder(slFolder)
Set flslFiles = follFolder.Files
slExt = UCase(spFileNames(0))
For Each flslFile In flslFiles
slFileName = flslFile.Name
'Correct EXT?
If slExt = UCase(olFS.GetExtensionName(slFileName)) Then
' Strip the EXT.
slExt = "." & slExt
slShortFileName = Replace(UCase((slFileName)), slExt, "")
' Add to Arrays.
ReDim Preserve spFullFileNames(UBound(spFullFileNames) + 1)
spFullFileNames(UBound(spFullFileNames)) = slFolder & "\" & slFileName
ReDim Preserve spFileNames(UBound(spFileNames) + 1)
spFileNames(UBound(spFileNames)) = slShortFileName
End If
Next flslFile
For Each follSubFolder In follFolder.SubFolders
spFullFileNames(0) = follSubFolder.Path
subGetFileNames spFullFileNames, spFileNames
Next follSubFolder
' *********************************************************************
End Sub
Bookmarks