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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Cpier/coller en VBA
Réponses
7
Affichages
649
Réponses
5
Affichages
771
Réponses
0
Affichages
676
Réponses
2
Affichages
1 K
Retour