VBA recursive function get data only from new files. - excel

Question

Im using recursive function for getting specific data from files in folders and subfolders on my disk. This data are saved as a new row in my excel file and create the table. It works fine. But if I create new file and put it into random subfolder, after starting the recursive function, I want to add that data as new row in my table that was created before. Instead of removing whole table and then repeatedly start recursive function and get data in the table.
Something like refresh button - if I click on it, it will check every folder and subfolder and if find some new file or files, add them on the last row in the table.
This is the code I´m using now:
Function Recurse(sPath As String) As String
Dim FSO As New FileSystemObject
Dim myFolder As Folder
Dim mySubFolder As Folder
Dim myFile As File
Dim erow
Dim Black
Dim cislokabla
Set myFolder = FSO.GetFolder(sPath)
For Each mySubFolder In myFolder.SubFolders
For Each myFile In mySubFolder.Files
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
GetData myFile, "Sheet1", _
"F1:F2", Sheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 1)), True, False
Black = Sheet1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
GetData myFile, "Sheet1", _
"O4:O5", Sheets("Sheet1").Range(Cells(Black, 2), Cells(Black, 2)), True, False
cislokabla = Sheet1.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
GetData myFile, "Sheet1", _
"AH1:AH2", Sheets("Sheet1").Range(Cells(Black, 3), Cells(Black, 3)), True, False
Next
Recurse = Recurse(mySubFolder.Path)
Next
End Function
Sub nacitavaniedat()
Call Recurse("\\Sk-wftkabel\public\Identifikačné listy káblov\káble\")
End Sub

Answer 1

you need sheet2 named "Sheet2" to store filenames :)
(changed 30.01.14)
Sub Recurse()
Dim FSO As New FileSystemObject
Dim myFolder As Scripting.Folder, mySubFolder As Scripting.Folder
Dim myFile As File
Dim sPath$: sPath = "\\Sk-wftkabel\public\Identifikacne listy kablov\kable\"
Dim R$
R = Join(Application.Transpose(Sheets("Sheet2").UsedRange), "|")
Set myFolder = FSO.GetFolder(sPath)
For Each mySubFolder In myFolder.SubFolders
For Each myFile In mySubFolder.Files
DoEvents
If Not (InStr(1, R, myFile.Path) > 0) Then
GetData myFile, "Sheet1", "F1:F2", Sheets("Sheet1").Range(Sheets(1).Cells(Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1), Sheets(1).Cells(Sheet1.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)), True, False
GetData myFile, "Sheet1", "O4:O5", Sheets("Sheet1").Range(Sheets(1).Cells(Sheet1.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2), Sheets(1).Cells(Sheet1.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2)), True, False
GetData myFile, "Sheet1", "AH1:AH2", Sheets("Sheet1").Range(Sheets(1).Cells(Sheet1.Cells(Rows.Count, 3).End(xlUp).Row + 1, 3), Sheets(1).Cells(Sheet1.Cells(Rows.Count, 3).End(xlUp).Row + 1, 3)), True, False
Sheets("Sheet2").Cells(Sheets("Sheet2").UsedRange.Rows.Count + 1, 1).Value = myFile.Path
R = R & myFile.Path & "|"
End If
Next
Next
Set FSO = Nothing
Set myFolder = Nothing
Set mySubFolder = Nothing
Set myFile = Nothing
End Sub
Option Explicit
Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
SourceRange As String, TargetRange As Range, Header As Boolean,
UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
Dim rsCon As Object
Dim rsData As Object
Dim szConnect As String
Dim szSQL As String
Dim lCount As Long
' Create the connection string.
If Header = False Then
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=No"";"
End If
Else
If Val(Application.Version) < 12 Then
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & SourceFile & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
End If
If SourceSheet = "" Then
' workbook level name
szSQL = "SELECT * FROM " & SourceRange$ & ";"
Else
' worksheet level name or range
szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
End If
On Error GoTo SomethingWrong
Set rsCon = CreateObject("ADODB.Connection")
Set rsData = CreateObject("ADODB.Recordset")
rsCon.Open szConnect
rsData.Open szSQL, rsCon, 0, 1, 1
' Check to make sure we received data and copy the data
If Not rsData.EOF Then
If Header = False Then
TargetRange.Cells(1, 1).CopyFromRecordset rsData
Else
'Add the header cell in each column if the last argument is True
If UseHeaderRow Then
For lCount = 0 To rsData.Fields.Count - 1
TargetRange.Cells(1, 1 + lCount).Value = _
rsData.Fields(lCount).Name
Next lCount
TargetRange.Cells(2, 1).CopyFromRecordset rsData
Else
TargetRange.Cells(1, 1).CopyFromRecordset rsData
End If
End If
Else
MsgBox "No records returned from : " & SourceFile, vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
rsCon.Close
Set rsCon = Nothing
Exit Sub
SomethingWrong:
MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
vbExclamation, "Error"
On Error GoTo 0
End Sub