Excel macro that loops through directory, then lists file name and a certain cell value

[CMDMA03]

I'm fairly new to vba for excel and I need a little guidance on a macro that I've pieced together from multiple web sources (pasted below). I've search for a couple of days, and nothing I've found gets me what I want.

The macro loops through files in a specific directory and sums values from one cell on a specific sheet. I'd like to expand the macro to record the file name and the specified sheet's cell value (i.e., B53) for each file that it loops through and begin listing them within in A23 and B23 respectively. Can anyone help with this?

I'm using excel 2003 if this is necessary.

Sub XLS2CSV()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim sheeetname As String
Dim boookname As String
Dim location As String
Dim csv As String
Dim vaFileName As Variant
Dim wbkData As Workbook
Dim dMySum As Double

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

' Records the total number of errors in the directory files
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = "S:\Community Services\SOCS Contracts Administration\PCCO\R3_MH\R3_Conversion_Directory" 'the directory to search in
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'workbooks found
Application.ScreenUpdating = False
For Each vaFileName In .FoundFiles 'loop through each found workbook
Set wbkData = Workbooks.Open(Filename:=vaFileName, UpdateLinks:=0) 'open the workbook
With wbkData
With .Worksheets("Notes").Range("B53")
If IsNumeric(.Value) Then dMySum = dMySum + .Value 'add the desired value
End With
.Close savechanges:=False 'close without saving
End With
Next vaFileName
Application.ScreenUpdating = True
Range("B22") = dMySum
Range("B22").Select
Selection.Font.Bold = True
Range("B22").Font.ColorIndex = 0
Else
MsgBox "There were no Excel files found."
End If
End With

 

[CMDMA03]

I ended up finding someone to assist with this one (full code is pasted below). It now does exactly what I wanted it to do. All of these processes were pulled off of the web and pieced together. I've tried to add as many notes as possible to it so that the next person can just modify to suit.


Sub XLS2CSV()

Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim sheeetname As String
Dim boookname As String
Dim location As String
Dim csv As String
Dim vaFileName As Variant
Dim wbkData As Workbook
Dim dMySum As Double
Dim strB53CellValue As String
Dim intRowCounter As Integer


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

' Records the total number of errors in the directory files
intRowCounter = 22
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = "S:\Community Services\SOCS Contracts Administration\PCCO\R3_MH\R3_Conversion_Directory\" 'the directory to search in
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then 'workbooks found
Application.ScreenUpdating = False
For Each vaFileName In .FoundFiles 'loop through each found workbook
intRowCounter = intRowCounter + 1
Set wbkData = Workbooks.Open(Filename:=vaFileName, UpdateLinks:=0, ReadOnly:=True) 'open the workbook read only
With wbkData
With .Worksheets("Notes").Range("B53")
If IsNumeric(.Value) Then dMySum = dMySum + .Value 'add the desired value
strB53CellValue = .Value 'captures the value that was added to the dMySum total
End With
.Close savechanges:=False 'close without saving
End With
Application.ScreenUpdating = True
Range("A" & intRowCounter) = Dir(vaFileName) 'Lists filename in column a starting at row 23
Range("B" & intRowCounter) = strB53CellValue 'Lists error value in column b starting at row 23
vaFileName = ""
strB53CellValue = ""
Application.ScreenUpdating = False
Next vaFileName
Application.ScreenUpdating = True
Range("B22") = dMySum 'Lists the total errors within all found files
Range("B22").Select
Selection.Font.Bold = True
Range("B22").Font.ColorIndex = 0
Else
MsgBox "There were no Excel files found."
End If
End With

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

'Saves the expenditure and revenue tabs to CSV for MBOW load
On Error Resume Next
Set wbCodeBook = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = "S:\Community Services\SOCS Contracts Administration\PCCO\R3_MH\R3_Conversion_Directory" 'Pathway for base files
.FileType = msoFileTypeExcelWorkbooks 'Optional filter with wildcard or .Filename = "Book*.xls"
If .Execute > 0 Then 'Workbooks in folder
For lCount = 1 To .FoundFiles.Count 'Loop through all Workbooks and save specified sheets as CSV files
Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0, ReadOnly:=True) 'open the workbook read only
Sheets("Exp_DB_Sched").Activate 'Place sheet name here
location = "S:\Community Services\SOCS Contracts Administration\PCCO\R3_MH\R3_Active_Converted\"
'Pathway for saved CSV Files (make sure '\' on the end of pathway)
sheeetname = ActiveSheet.Name
boookname = ActiveWorkbook.Name
csv = ".csv"
ActiveWorkbook.SaveAs Filename:=location + Left(boookname, 3) + "_" + sheeetname + csv, _
FileFormat:=xlCSV, CreateBackup:=False 'naming convention for saved CSV file
Sheets("III_Revenue_MH").Activate 'Place sheet name here
sheeetname = ActiveSheet.Name
ActiveWorkbook.SaveAs Filename:=location + Left(boookname, 3) + "_" + sheeetname + csv, _
FileFormat:=xlCSV, CreateBackup:=False 'naming convention for saved CSV file
wbResults.Close savechanges:=False 'close without saving
Next lCount
End If
End With

' Counts the number of CSV files created for MBOW load
intRowCounter = 22
On Error GoTo 0
With Application.FileSearch
.NewSearch
.LookIn = "S:\Community Services\SOCS Contracts Administration\PCCO\R3_MH\R3_Active_Converted\" 'Pathway for saved CSV Files
.FileType = msoFileTypeAllFiles 'Searches all file types
If .Execute > 0 Then 'workbooks found
Application.ScreenUpdating = False
For Each vaFileName In .FoundFiles 'loop through each found workbook
intRowCounter = intRowCounter + 1
Application.ScreenUpdating = True
Range("I" & intRowCounter) = Dir(vaFileName) 'Returns the file name of a files present within the pathway for saved CSV in column i starting at row 23
vaFileName = ""
Application.ScreenUpdating = True
Next vaFileName
Application.ScreenUpdating = True
Range("H22") = (.FoundFiles.Count) 'Returns a count of all files present within the pathway for saved CSV Files in cell B21
Range("H22").Select
Selection.Font.Bold = True
Range("H22").Font.ColorIndex = 0
End If
End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True

End Sub