homegrownandy
New Member
- Joined
- Jun 15, 2015
- Messages
- 7
Code:
Sub Test()
Dim strFiles As Variant
Dim lngLoop As Long
Dim lngRow As Long
Dim wb As Excel.Workbook
On Error GoTo Catch
Application.ScreenUpdating = False
'// Change directory as needed
strfile = Split(TFILES("C:\Users\Admin\Documents\test", True, "*.XLSX"), vbCrLf)
For lngLoop = 0 To UBound(strfile)
'// TFiles seems to return an additional blank element at the end.
If strfile(lngLoop) <> vbNullString Then
Set wb = Workbooks.Open(strfile(lngLoop))
'// Assuming everything goes to the sheet named. Sheet1. Used any old cell references. Will need to change
lngRow = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
ThisWorkbook.Sheets("Sheet1").Range("A" & lngRow).Value = wb.ActiveSheet.Range("C4").Value
ThisWorkbook.Sheets("Sheet1").Range("B" & lngRow).Value = wb.ActiveSheet.Range("D4").Value
ThisWorkbook.Sheets("Sheet1").Range("C" & lngRow).Value = wb.ActiveSheet.Range("E4").Value
wb.Close SaveChanges:=xlDoNotSaveChanges
Set wb = Nothing
End If
Next
Catch:
Application.ScreenUpdating = True
End Sub
Private Function TFILES(parentFolder As String, searchSubfolders As Boolean, _
Optional searchParams As String = "*.*") As String
vSub = ""
If searchSubfolders = True Then vSub = "/S "
If Right(parentFolder, 1) <> "\" Then parentFolder = parentFolder & "\"
TFILES = CreateObject("WScript.Shell").Exec("CMD.exe /S /C DIR " & Chr(34) & _
parentFolder & searchParams & Chr(34) & Space(1) & vSub & "/B").StdOut.ReadAll
End Function
I'm using the code above (from a different forum) to search folders and sub folders for xlsx files, and then display results on the workbook I run it from,
However I cant get this to work, Is there any obvious mistakes I've made?
There is no error message so I'm assuming its all running okay its just the fact I get no results.
Thanks in advance!
Andrew.