Preventing off retrieve data multiple times

[ramborabs]

Hello everybody,

Current program i use follows these steps:

-Empty cells

-Remove comments

- Fill Headers

- Retrieve Data (From the path Results (a subdirectory))

- Sort on date and time (column D)

My Problem: The programma now used retrieves every file in the subdirectory again and again.
If it has like 100-200 files it takes a very long time.

Is it possible to make a function for this that only retrieves files when the filename is not imported already? (Title is in the D Column)

Wish: a function that retrieves only the required data and skips measuring data thats already there.

[Kaper]

few concepts:
a. add checking if the filename is already in column D (easy to do with COUNTIF) and open only if not
b. make small change to name as file is retieved (for instance oldfilename_RET.oldextension)
c. move file with retrieved data to another location (subfolder?)

any of this will require ingerention in program. (proposition c. can be easily done also manually or written as a shell script in your operating system)

[ramborabs]

few concepts:
a. add checking if the filename is already in column D (easy to do with COUNTIF) and open only if not
b. make small change to name as file is retieved (for instance oldfilename_RET.oldextension)
c. move file with retrieved data to another location (subfolder?)

any of this will require ingerention in program. (proposition c. can be easily done also manually or written as a shell script in your operating system)

Heres my code

    Dim basebook As Workbook
    Dim basesheet As Worksheet
    Dim mybook As Workbook
    Dim mysheet As Worksheet
    Dim cnum As Long
    Dim rnum As Long
    Dim strDate As String
    Dim i As Long 'Meetrapporten
    Dim j As Long 'Meetobjecten in meetrapport
    Dim jMax As Long
    Dim k As Long 'Meetobjecten in RawData
    Dim kMax As Long
    Dim kolommenMax As Long
    Dim rijenMax As Long
    Dim aantalBestandenMax As Long
    Dim aantalMeetobjectenMax As Long
    Dim a As Long
    Dim Path As String          '   Zoekt in deze map
    Dim begincnum As Integer    '   Begint met data kopieren in kolom begincnum
    Dim beginrnum As Integer    '   Begint met data kopieren in rij beginrnum
    
    'begincnum = 8
    begincnum = 5
    beginrnum = 5
    rnum = beginrnum
    kolommenMax = 16364
    rijenMax = 1048576
    aantalBestandenMax = 1048576 - begincnum     '   Er kunnen maximaal aantalBestandenMax meetrapporten verwerkt worden
    aantalMeetobjectenMax = 16364 - beginrnum + 1 '   Er kunnen maximaal aantalMeetobjectenMax meetobjecten verwerkt worden
    Path = ThisWorkbook.Path & "\Results\"
    Application.ScreenUpdating = False
    
    With Application.FileSearch
        .NewSearch
        '   In deze folder staan de bronbestanden
        .LookIn = Path
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            Set basebook = ThisWorkbook
            Set basesheet = basebook.Sheets("RawData")
            '   Controle of er niet meer dan het maximaal toegestane aantal van aantalBestandenMax meetrapporten wordt overschreden.
            aantalbestanden = .FoundFiles.Count
            If aantalbestanden > aantalBestandenMax Then
                Dim serror As String
                serror = "U probeert " & aantalbestanden & " meetrapporten te vewerken!" _
                    & Chr(13) & "U kunt maximaal " & aantalBestandenMax & " meetrapporten verwerken!" _
                    & Chr(13) & "Het verzamelen van meetgegevens wordt gestaakt!"
                MsgBox (serror)
                aantalbestanden = aantalBestandenMax
                Exit Sub
            End If
            
             For i = 1 To 1
                Set mybook = Workbooks.Open(.FoundFiles(i))
                Set mysheet = mybook.Sheets("report")
                jMax = mysheet.Range("A65536").End(xlUp).Row
                
                '   Er kunnen maar een beperkt aantal meetobjecten verwerkt worden.
                If jMax > kolommenMax - (16364) Then
                    MsgBox ("Er zijn " & jMax - 13 & " meetobjecten in het meetrapport gevonden. Dit kunnen er maximaal " & aantalMeetobjectenMax & " zijn!" & Chr(13) & "Excel neemt nu de eerste " & aantalMeetobjectenMax & " meetobjecten mee.")
                    jMax = kolommenMax - (begincnum - 1 + 13)
                End If
            Next i

            i = 0
            '   Alle gevonden bestanden langslopen
            For i = 1 To aantalbestanden
                Set mybook = Workbooks.Open(.FoundFiles(i))
                Set mysheet = mybook.Sheets("report")

Don't really know where to put the countif file, anyone that knows where to use it? Thanx in Advance