XL 2016 Boucle sur sous répertoire fso.GetFolder SharePoint

Aldonanou

XLDnaute Junior
Bonjour,

J'effectue une boucle pour aller récupérer les données de l'onglet Archives du fichier "Formulaire de déclaration des ventes.xlsm" pour 10 sous-répertoires et cela fonctionnait très bien.

Cependant, il est maintenant nécessaire que j'adapte mon code pour effectuer le même travail sous SharePoint et le programme bloque sur

For Each r In fso.GetFolder(Rep).SubFolders avec comme message d'erreur : Erreur d'exécution 76 chemin d'accès introuvable. J'ai trouvé sur un site qu'il faudrait ajouter CreateObject("Microsoft.XMLHTTP") mais je ne parviens pas à intégrer la ligne de commande.


VB:
Sub Boucler_Fichiers_Rep()

'On Error GoTo GestionErreur

Application.ScreenUpdating = False

Dim fso As Object, Rep As String
Dim r As Object, f As Object, Fichier As String
Dim FicImport As String, NomFic As String
Dim NbCol As Long, NbLigne As Long
Dim i As Integer, J As Integer
Dim l As Integer, c As Integer
Dim ligne As Integer, col As Integer


'On commence par le nombre de colonnes et de lignes totales
NbCol = Application.Columns.Count
NbLigne = Application.Rows.Count
'On définie les colonnes et les lignes du fichier où on importe à 1
l = 1
c = 1

'On n'affiche pas l'alerte
Application.DisplayAlerts = False

FicImport = "Ventes " & Format(Date, "YYYYMMDD")

Workbooks.Add.SaveAs Filename:="https://aldonanou.sharepoint.com/sites/Aldonanou/Services/Voitures/PILOTAGE%20TRES%20BIEN%202023/Sauvegardes%20fichiers/" & FicImport
FicPrincipal = "Menu de pilotage TRES BIEN sp.xlsm"
LaOuJeSauve = "https://aldonanou.sharepoint.com/sites/Aldonanou/Services/Voitures/PILOTAGE%20TRES%20BIEN%202023/TRES%20BIEN/"
Import = "https://aldonanou.sharepoint.com/sites/Aldonanou/Services/Voitures/PILOTAGE%20TRES%20BIEN%202023/TRES%20BIEN/Import/"

NomFic = ActiveWorkbook.Name

Set fso = CreateObject("Scripting.FileSystemObject")
Rep = "https://aldonanou.sharepoint.com/sites/Aldonanou/Public/SAV%20NEW%202023/"
Fichier = "Formulaire de déclaration des ventes.xlsm"

' r = sous-répertoire
' f  =Fichier


For Each r In fso.GetFolder(Rep).SubFolders
    For Each f In r.Files
        If f.Name = Fichier Then
            'On créée une feuille dans notre fichier d'import
            Workbooks(NomFic).Sheets.Add(After:=Sheets(Sheets.Count)).Name = r.Name
            
            'On désactive les macros
            Application.EnableEvents = False
    
            Workbooks.Open Filename:=Rep & r.Name & "\" & f.Name
            
            'On désactive les macros
            Application.EnableEvents = True
        
            'On se place dans le fichier source
            With Workbooks(Fichier).Sheets("ArchiveA")
                'On compte le nombre de lignes et de colonnes
                ligne = .Cells(NbLigne, 1).End(xlUp).Row
                col = .Cells(1, NbCol).End(xlToLeft).Column
                l = 1
                'On boucle sur les lignes
                For i = 1 To ligne
                'On remet la colonne du fichier où on importe à 1
                    c = 1
                    'On boucle sur les colonnes
                    For J = 1 To col
                        'On colle la cellule
                        Workbooks(NomFic).Sheets(r.Name).Cells(l, c).Value = .Cells(i, J).Value
                        'On incrémente la colonne
                        c = c + 1
                    Next
                    'On incrémente la ligne
                    l = l + 1
                Next
                
            End With
            
            'On ferme le fichier source
            Workbooks(f.Name).Close
        End If
    Next f
Next r
Workbooks(NomFic).Sheets(1).Delete
Workbooks(NomFic).Save

'On remet les alertes en place
Application.DisplayAlerts = True

Quelqu'un aurait-il une idée.

Merci d'avance

Cordialement
 

Discussions similaires

Statistiques des forums

Discussions
312 207
Messages
2 086 246
Membres
103 163
dernier inscrit
Pelaez