Goedemiddag,

Loop nu al eindje te zoeken, en onder het moto durf te vragen, stel ik het hier maar eens. Als ik ergens in de juiste richting raak ben ik al tevreden.
Ik (werk gerelateerd) klasseer de CMR's van mijn bedrijf digitaal per nummer in mappen ( startnummer - eindnummer) op onze server.
dit werkt , maar is niet overzichtelijk welke ik ontbreek en van welke chauffeur. nu zou ik willen dit in excel trekken om het vlotter te kunnen opvolgen.
ken wel wat van excel en ietsje van VBA maar toch lukt het mij niet om het goed te krijgen.
Wat ik wil is dat de er in de folders (kolom A) uit folderpad van de server ( beetje zoals verticaalzoeken) gezocht word naar pdf,s en dat de nummers van de pdf,s horizontaal worden weergegeven in  kolom E tem kolom AC (want CMR's worden ingescand volgens hun nummer en bewaard in hun hoofmap per boek
Als ik in  kolom A nieuwe boeken toevoeg zouden  deze ook als nieuwe map moeten worden aangemaakt op de server.
Het lukt mij om in folders te zoeken via VBA maar dan worden ze altijd verticaal getoond. wat ik ook probeer niks werkt zoals ik het zou willen

Iemand die mij kan helpen aan werkend VBA scriptje of ander manier is ook goed
 Alvast ne dikke merci


                                                         

Hey SoftAid

heb een (gestripte versie) erop gezet omdat hij met VBA er heel verknipt uit kwam je ziet anders niet meer wat het hoort te zijn.

maar dit is mn scriptje tot nu toe ( maar lukt mij niet om te kunnen zoeken vanaf kolom A en de files worden altijd verticaal getoond

Q:

Sub getfiles()

    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object, sf
    Dim i As Integer, colFolders As New Collection, ws As Worksheet
   
    Set ws = ActiveSheet
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.getfolder("\\OX-DC-DATA\Data\4-PRODUCTION\CMR ARCHIEF\2023\")
   
    colFolders.Add oFolder
   
    Do While colFolders.Count <> Range = A
        Set oFolder = colFolders(1)
        colFolders.Remove 1
   
        For Each oFile In oFolder.Files
            If oFile.DateLastModified > Now - 7 Then
                ws.Cells(i + 1, 2) = oFile.Name
                i = i + 1
            End If
        Next oFile

       
        For Each sf In oFolder.subfolders
            colFolders.Add sf
        Next sf
    Loop

End Sub

UQ

zal aan mij liggen vrees ik maar als ik Column toevoeg ( en denk dat hij moet starten op de 5de) doet hij niks, krijg fout melding.
For Each oFile In oFolder.Files
            If oFile.DateLastModified > Now - 7 Then
                ws.Cells(Column 5) + 1, 2) = oFile.Name
                i = i + 1
            End If
        Next oFile

Probeer deze eens

Sub jec()
Dim a
a = Split(CreateObject("wscript.shell").Exec("cmd /c Dir ""\\OX-DC-DATA\Data\4-PRODUCTION\CMR ARCHIEF\2023\*.pdf ""/b/o:d/s").StdOut.ReadAll, vbCrLf)
Cells(2, 5).Resize(, UBound(a)) = a
End Sub

Hallo maikel81,

Wat ik bedoelde: in woorden:  Worksheets.Cells(Rows, Columns + variabele i) = variabele oFile.name

in code:

Code: [Selecteer]

For Each oFile In oFolder.Files
            If oFile.DateLastModified > Now - 7 Then
                ws.Cells(2, i +5) = oFile.Name  'omdat je i geen waarde geeft op voorhand, veronderstel ik dat deze 0 is in het begin van je oFile-loop
                i = i + 1
            End If
        Next oFile
Je kan ook i = 5 zetten in je code, dan wordt het duidelijker:

Code: [Selecteer]

For Each oFile In oFolder.Files
             i = 5
            If oFile.DateLastModified > Now - 7 Then
                ws.Cells(2, i ) = oFile.Name 
                i = i + 1
            End If
        Next oFile

SoftAid              

Hij zet alle waarden in veld 5

Is je aangegeven pad in je code de hoofdfolder en zijn de aangegeven folders in kolom A alllemaal subfolders? Heten deze letterlijk xxxxxx-xxxxxx? Dus met streepje ertussen

Probeer dan deze eens.
Bij ontbreken van de folder wordt deze aangemaakt.

Sub jec()
 Dim ar, xp, it, i As Long
 ar = Range("A2", Range("A" & Rows.Count).End(xlUp))
 ReDim sq(UBound(ar), 500)
 
 With CreateObject("Scripting.FileSystemObject")
   For i = 1 To UBound(ar)
      xp = "\\OX-DC-DATA\Data\4-PRODUCTION\CMR ARCHIEF\2023\" & ar(i, 1) & "\"
      If Not .FolderExists(xp) Then .createfolder xp
      For Each it In .getfolder(xp).Files
         If it.Name Like "*.pdf" And it.DateLastModified > Date - 7 Then
            sq(i - 1, x) = Split(it.Name, ".pdf")(0)
            x = x + 1
         End If
      Next
      x = 0
   Next
 End With
 Range("E2").Resize(UBound(ar), 25) = sq
End Sub

Graag gedaan hoor.
Wat je vraagt kan allemaal. Na het weekend heb ik misschien weer even tijd. Druk druk!