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.
	
	
	
	
	
		
Quelqu'un aurait-il une idée.
Merci d'avance
Cordialement
	
		
			
		
		
	
				
			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 = TrueQuelqu'un aurait-il une idée.
Merci d'avance
Cordialement
 
	 
 
		