How to loop folder , sub folder and files in the sql server ?

Question

Hi,
I have a folder , sub folder and files like this.
Here AuditSearchHistory fixed folder and contains 2 subfolders , but some times it may contain more sub folders also.
Please help me to loop the subfolders to get xls files in the sql without SSIS , Because I need to get just xls file paths.
Thank you.

Answer 1

Please run these Macros in Excel.
Sub TestListFilesInFolder()
' Open folder selection
' Open folder selection
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
pPath = .SelectedItems(1)
If Right(pPath, 1) <> "\" Then
pPath = pPath & "\"
End If
End With
NextCode: 'MsgBox "No files Selected!!"
'Application.WindowState = xlMinimized
'Application.ScreenUpdating = False
Workbooks.Add ' create a new workbook for the file list
' add headers
ActiveSheet.Name = "ListOfFiles"
With Range("A2")
.Formula = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "File Name:"
Range("B3").Formula = "File Size:"
Range("C3").Formula = "File Type:"
Range("D3").Formula = "Date Created:"
Range("E3").Formula = "Date Last Accessed:"
Range("F3").Formula = "Date Last Modified:"
Range("A3:F3").Font.Bold = True
Worksheets("ListOfFiles").Range("A1").Value = pPath
Range("A1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Font.Bold = True
ListFilesInFolder Worksheets("ListOfFiles").Range("A1").Value, True
' list all files included subfolders
Range("A3").Select
Lastrow = Range("A1048576").End(xlUp).Row
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Worksheets("ListOfFiles").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ListOfFiles").Sort.SortFields.Add Key:=Range( _
"B4:B" & Lastrow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ListOfFiles").Sort
.SetRange Range("A3:F" & Lastrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
Cells.Select
Cells.EntireColumn.AutoFit
Columns("A:A").Select
Selection.ColumnWidth = 100
Range("A1").Select
End Sub
Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A1048576").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.Path & FileItem.Name
Cells(r, 2).Formula = (FileItem.Size / 1048576)
Cells(r, 2).Value = Format(Cells(r, 2).Value, "##.##") & " MB"
Cells(r, 3).Formula = FileItem.Type
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastAccessed
Cells(r, 6).Formula = FileItem.DateLastModified
' use file methods (not proper in this example)
r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Columns("A:F").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
Or . . .
Option Explicit
Sub CreateList()
Application.ScreenUpdating = False
Workbooks.Add ' create a new workbook for the folder list
' add headers
ActiveSheet.Name = "ListOfFiles"
With Cells(3, 1)
.Value = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Cells(4, 1).Value = "Folder Path:"
Cells(4, 2).Value = "Folder Name:"
Cells(4, 3).Value = "Folder Size:"
Cells(4, 4).Value = "# Subfolders:"
Cells(4, 5).Value = "# Files:"
Range("A3:E3").Font.Bold = True
ListFolders BrowseFolder, True
Application.ScreenUpdating = True
Cells.Select
Cells.EntireColumn.AutoFit
Columns("A:A").Select
Selection.ColumnWidth = 100
Columns("B:B").Select
Selection.ColumnWidth = 25
Range("A1").Select
End Sub
Sub ListFolders(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the folders in SourceFolder
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
' display folder properties
Worksheets("ListOfFiles").Range("A1").Value = SourceFolderName
Range("A1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Font.Bold = True
r = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(r, 1).Value = SourceFolder.Path
Cells(r, 2).Value = SourceFolder.Name
Cells(r, 3).Value = SourceFolder.Size
Cells(r, 3).Value = (SourceFolder.Size / 1048576)
Cells(r, 3).Value = Format(Cells(r, 3).Value, "##.##") & " MB"
Cells(r, 4).Value = SourceFolder.SubFolders.Count
Cells(r, 5).Value = SourceFolder.Files.Count
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFolders SubFolder.Path, True
Next SubFolder
Set SubFolder = Nothing
End If
Columns("A:E").AutoFit
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
Or . . .
Const BIF_RETURNONLYFSDIRS As Long = &H1 ''' For finding a folder to start document searching
Const BIF_DONTGOBELOWDOMAIN As Long = &H2 ''' Does not include network folders below the domain level in the tree view control
Const BIF_RETURNFSANCESTORS As Long = &H8 ''' Returns only file system ancestors.
Const BIF_BROWSEFORCOMPUTER As Long = &H1000 ''' Returns only computers.
Const BIF_BROWSEFORPRINTER As Long = &H2000 ''' Returns only printers.
Const BIF_BROWSEINCLUDEFILES As Long = &H4000 ''' Returns everything.
Const MAX_PATH As Long = 260
Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Declare Function SHGetPathFromIDListA Lib "shell32.dll" (ByVal pidl As Long, ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" (lpBrowseInfo As BROWSEINFO) As Long
Function BrowseFolder() As String
Const szINSTRUCTIONS As String = "Choose the folder to use for this operation." & vbNullChar
Dim uBrowseInfo As BROWSEINFO
Dim szBuffer As String
Dim lID As Long
Dim lRet As Long
With uBrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = szINSTRUCTIONS
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
szBuffer = String$(MAX_PATH, vbNullChar)
''' Show the browse dialog.
lID = SHBrowseForFolderA(uBrowseInfo)
If lID Then
''' Retrieve the path string.
lRet = SHGetPathFromIDListA(lID, szBuffer)
If lRet Then BrowseFolder = Left$(szBuffer, InStr(szBuffer, vbNullChar) - 1)
End If
BrowseFolder = BrowseFolder & "\"
End Function
Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.