VBA voor informatie ophalen uit Excel bestanden op sharepoint

[FoekjeJong]

Hi All,

Ik heb de onderstaande code geschreven (naja, met hulp van AI) om door de submappen van een map op sharepoint te bladeren en te zoeken naar bestanden die starten met 2024. Vanuit deze bestanden wil ik bepaalde informatie halen voor in een nieuw overzicht bestand. Heb de sharepointlink er even uitgehaald.

Ik denk dat het openen van sharepoint niet echt nodig is.
het probleem is dat hij stopt na de regel For Each subfolder In Folder.Items

Ik zou denken dat dit betekent dat hij geen submappen kan vinden.
De sharepointlocatie is al een submap van andere mappen, levert dit het probleem op? (Documents >Finance > COSN > 03. Signed)

Sub OpenSharePointInEdge()
    Dim wbk As Workbook, sh As Worksheet, doel As Workbook
    Set doel = ThisWorkbook
    Dim Edge As Object
    Set Edge = CreateObject("Shell.Application")
    Dim subfolder As Object
    Dim file As Object
    Dim Folder As Object
    Dim RowCounter As Long ' Teller voor rijen
  
    ' Open de SharePoint-site in Microsoft Edge
    Edge.ShellExecute "Sharepointlink", "", "", "open", 1
  
    ' Wacht tot de pagina is geladen (optioneel)
    ' Voer hier je verdere bewerkingen uit
  
    ' Haal de mapreferentie op
    Set Folder = Edge.Namespace("Sharepointlink")
  
    ' Initialiseer de teller
    RowCounter = 4 ' Start in rij 4 (cel A4)
  
    For Each subfolder In Folder.Items
        If subfolder.IsFolder Then
            Debug.Print "Mapnaam: " & subfolder.Name
          
            ' Itereer door elk bestand in de submap
            For Each file In subfolder.Items
                If file.Name Like "2024*" Then ' Controleer of bestandsnaam begint met "2024"
                    Debug.Print "Bestandsnaam: " & file.Name
                    Set wbk = Workbooks.Open(file.Path)
                  
                    ' Verwerk alleen het eerste werkblad
                    Set sh = wbk.Sheets(1)
                    With doel.Sheets("Overview")
                        .Cells(RowCounter, 1).Value = sh.Range("C5").Value ' Haal waarde uit cel C5
                    End With
                                       wbk.Close SaveChanges:=False
                    RowCounter = RowCounter + 1 ' Volgende rij
                End If
            Next file
        End If
    Next subfolder
  
    Set Edge = Nothing
End Sub

 

[JEC.]

Kijk eens naar Power Query