XL 2016 Télécharger fichiers sur team site

Fab117 · 17 Mai 2019

Hello,
J'ai plusieurs team sites (share points) sur lesquels j'ai de nombreux fichiers.
Je souhaiterais faire de temps en temps des backups de mes team sites.
N'ayant pas les droits nécessaires (ni les connaissances), pour le faire depuis le team site, je souhaiterais faire une macro pour qu'Excel me pilote tout ça.

Mon approche:
1. Depuis chacune des librairies du team site, je fais un export vers Excel

2. Je créé une boucle sur toutes les lignes de mon fichiers (depuis la n°2)

3. Dans les cellules "A", il y a l'URL de chaque fichier. Je récupère l'URL dans la variable "fichier_internet" (ce sera ma source)

4. Sur la base de l'URL d'accès, je fais différentes opérations sur la chaîne de caractères pour définir le chemin cible (où je veux copier le fichier) et le mets dans la variable "fichier_local"

5. Sur la base du chemin cible, je créé le répertoire et les sous répertoires devant revoir le fichier

NB: Lorsque je teste le contenu de mes 2 variables, j'ai bien le bon chemin
si je copie le contenu de fichier_internet et que je le colle dans Internet Explorer, il m'ouvre bien le fichier du team site
si je copie le contenu de fichier_local et que je le colle dans l'explorateur de fichiers Windows, il m'ouvre bien le répertoire devant contenir le fichier

6. Ensuite, je suis bétement la méthodologie décrite ici
=> coller les 14 lignes de code en en-tête du module
=> insérer dans mon code :

VB:

Call TelechargerFichierInternet(fichier_internet, fichier_local)

Mais j'ai le message d'erreur :

NB: Si je fais une version simplifiée de ma macro (sans la boucle sur les lignes de mon fichier Excel), le fichier est bien copié dans mon répertoire cible.

Quelqu'un aurait-il une idée de comment procéder ?

Excellent week-end

Fab

Hasco · 17 Mai 2019

Bonjour,

Il vous suffit de modifier la première ligne de la procédure 'TéléchargerFichierInternet'.

Sub TéléchargerFichierInternet(ByVal Fichier_Internet, ByVal Fichier_Local)
....
End Sub

Normalement cela devrait fonctionner.

Bonne soirée

Fab117 · 20 Mai 2019

Bonjour,
Merci d'avoir pris le temps de regarder mon problème.
Pas sûr que j'ai bien compris comment procéder.
J'ai remplacé la première ligne de ma macro:

VB:

Sub BackupTeamSites()

par

Code:

Sub BackupTeamSites(ByVal Fichier_Internet, ByVal Fichier_Local)

Mais lorsque je l'exécute, j'ai la fenêtre suivante:

Voici une version épurée de mon code :
Tout d'abord les fonctions que j'ai reprises telles quelles:

Code:

Private Declare Function TelechargerFichierURL Lib "urlmon" _
Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long

Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10

Public Function TelechargerFichierInternet(SourceUrl As String, FichierLocal As String) As Boolean
TelechargerFichierInternet = TelechargerFichierURL(0&, SourceUrl, FichierLocal, BINDF_GETNEWESTVERSION, 0&) = ERROR_SUCCESS
End Function


'Création des répertoires et sous répertoires
Function CreerDossier(Chemin As String)
'par: Excel-Malin.com ( https://excel-malin.com )
    On Error GoTo CreerDossierErreur

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

If Len(Dir(Chemin, vbDirectory)) > 0 Then
CreerDossier = True
Exit Function
Else
        'suppression du dernier backslash si présent
        If Right(Chemin, 1) = Application.PathSeparator Then Chemin = Left(Chemin, Len(Chemin) - 1)
       
        'vérificacion si chemin local ou réseau
        If Left(Chemin, 2) = "\\" Then
            CheminReseau = True
        Else
            CheminReseau = False
        End If
       
        'décomposition du chemin
        If CheminReseau = False Then
            PartiesDeChemin = Split(Chemin, Application.PathSeparator)
            CheminPartielOK = ""
            PremierDossier = LBound(PartiesDeChemin)
        Else
            PartiesDeChemin = Split(Replace(Chemin, "\\", ""), Application.PathSeparator)
            CheminPartielOK = ""
            PremierDossier = LBound(PartiesDeChemin) + 1
        End If
   
    'tests et créations de (sous)dossiers
        For PartieDeChemin = PremierDossier To UBound(PartiesDeChemin)

            For CheminPartiel = LBound(PartiesDeChemin) To PartieDeChemin
           
                        If CheminReseau = False Then
                            CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator
                        Else
                            CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator
                        End If

                If CheminPartiel = PartieDeChemin Then
                        If CheminReseau = False Then
                                    If FSO.FolderExists(CheminPartielOK) = False Then
                                            MkDir CheminPartielOK
                                    End If
                        Else
                                    If Right(CheminPartielOK, 1) = Application.PathSeparator Then _
                                    CheminPartielOK = Left(CheminPartielOK, Len(CheminPartielOK) - 1)
                                   
                                    If Left(CheminPartielOK, 2) <> "\\" Then _
                                    CheminPartielOK = "\\" & CheminPartielOK
                                   
                                    If FSO.FolderExists(CheminPartielOK) = False Then
                                            MkDir CheminPartielOK
                                    End If
                        End If
                End If
            Next CheminPartiel
            CheminPartielOK = ""
        Next PartieDeChemin
End If

CreerDossier = True
Exit Function
CreerDossierErreur:
CreerDossier = False
End Function

Puis mon code épuré:

Code:

Sub BackupTeamSites(ByVal Fichier_Internet, ByVal Fichier_Local)

Dim CheminSource, CheminCible, CheminRecuperer As String
Dim PrefixeRepertoireCible, Prefixe1, Prefixe2 As String



' Définir le répertoire cible (disque dur, clé USB, ...)
PrefixeRepertoireCible = "C:\Users\fg512347\OneDrive - GSK\Desktop\Share points\"


'Liste des répértoire de premiers niveaux:
Prefixe1 = "Cible01\"
Prefixe2 = "Cible02\"


' Derniere ligne
DerniereLigne = Range("A65536").End(xlUp).Row

' Boucle sur les fichiers à traiter
For i = 2 To DerniereLigne
    If Range("D" & i) = "Fichier" Then
        Range("A" & i).Select
        '=>______________Définit les chemins sources et cibles
        CheminSource = Selection.Hyperlinks.Item(1).Address ' récupère le lien hypertexte du fichier dans la variable CheminSource
        ' Creation du chemin cible à partir du chemin source.
        LongueurChaine = Len(CheminSource) ' Nombre de caractère dans la variable CheminSource
        LonguerAExtraire = LongueurChaine - 30 ' On retire les 30 caractères de "https://myteams.abc.com/sites/"
        CheminRecuperer = Mid(CheminSource, 31, LonguerAExtraire) 'CheminSource = variable à analyser; 31 = commencer à regarder dès le 31ème caractère; LonguerAExtraire = Nb de caractère à regarder après le 31ème
        ' Il doit récupérer une partie du nom du lien qui lui permettra de savoir où copier le fichier

        ' Récupère le début du chemin qui permettra de faire le lien vers le répertoire cible où le fichier devra être copié
        PositionDuProchainSymboleBarreOblique = InStr(1, CheminRecuperer, "/") ' Commence à rechercher depuis le "1"er caractère le symbole"/" dans la variable CheminRecuperer
        InfoRepertoireCible = Mid(CheminRecuperer, 1, PositionDuProchainSymboleBarreOblique - 1) ' Récupère le chemin d'accès qui nous intéresse => sans "https://myteams.abc.com/sites/"
        ' Réajuste la partie à garder du lien
        LongueurChaine = Len(CheminRecuperer) - 1
        CheminRecuperer = Mid(CheminRecuperer, PositionDuProchainSymboleBarreOblique + 1, LongueurChaine) ' Récupère dans la variable CheminRecuperer le chemin d'accès qui nous intéresse => sans "https://myteams.abc.com/sites/", ni la référence propre au team site concerné
        CheminRecuperer = Replace(CheminRecuperer, "/", "\") ' Remplacer les "/" par des "\"
        CheminRecuperer = Replace(CheminRecuperer, "%20", " ") ' Remplacer les "%20" par des " "

        'Rajoute le préfixe au chemin cible => l'accès au répertoire du disque dur ou de la clé USB
            If InfoRepertoireCible = "abcdef" Then
                PrefixeRepertoire = PrefixeRepertoireCible & Prefixe1
            ElseIf InfoRepertoireCible = "ghijk" Then
                PrefixeRepertoire = PrefixeRepertoireCible & Prefixe2
            End If
       
        CheminCible = PrefixeRepertoire & CheminRecuperer
        '<=______________________
       
        '=>______________Création des répertoires et sous repertoires cibles si nécessaire
        ' A CORRIGER. iL FAUT ENLEVER LE NOM DU FICHIER DE CHEMIN CIBLE, CAR IL CREE UN SOUS REPRTOIRE A CE NOM
        Dim NouveauDossierAvecSousDossiers As String
        NouveauDossierAvecSousDossiers = CheminCible
        CreerDossier (NouveauDossierAvecSousDossiers)
        ' A CORRIGER. iL FAUT ENLEVER LE NOM DU FICHIER DE CHEMIN CIBLE, CAR IL CREE UN SOUS REPRTOIRE A CE NOM
        '<=______________________
       
       
        ' Pas compris pourquoi, mais les variables sources et cibles doivent s'appeler fichier_internet et fichier_local
        Dim Fichier_Internet, Fichier_Local As String
       
       
        Fichier_Internet = CheminSource
        Fichier_Local = CheminCible

        Call TelechargerFichierInternet(Fichier_Internet, Fichier_Local)

        '<=______________________

    End If
Next i

End Sub

Excellent début de semaine.

Fab

Hasco · 20 Mai 2019

Bonjour,

C'est la macro qui appelle cette dernière (BackupTeamSites) qu'il faut lancer, pas la macro avec des arguments. Vous devriez trouver un tutoriel d'initiation à VBA et particulièrement sur l'appel des procédures (macros) et fonctions.

Dans votre premier post vous aviez la ligne suivante qui buggait:
Call TelechargerFichierInternet(fichier_internet, fichier_local)
La macros qui contient cette ligne est à lancer.
Quid du nom de la procédure est devenu qui est devenu 'BackupTeamSites.' entre deux posts?

Bonne journée

Edit et P.S. Au fait si vous n'avez pas les droits sur le site, rien ne vous garantit que votre macro fonctionnera.

Fab117 · 20 Mai 2019

Rebonjour,
Merci pour cette explication (j'essayerai de dégager du temps pour suivre un tuto sur l'utilisation des procédures).
Par contre, c'est bien Back.up Teamsite que j'essaye de lancer (depuis l'éditeur VBA).
Et si j'essaye depuis le fichier Excel, elle n'apparait pas dans la liste des macros existantes

Et comme dit dans mon premier post, avec ma version simplifiée de mon code ("Test"), ça fonctionne => ça devrait jouer sans droit d'admin

Bon après-midi

Fab

Hasco · 20 Mai 2019

Re,

Suivez d'urgence un tuto où vous apprendrez que les macros paramétrées n'apparaissent jamais dans la liste des macros existantes, même si de manière tarabiscotée on peut les appeller par là en rajoutant les valeurs des paramètres dans une combinaison d' apostrophe et de guillemets.
Pour appeler la macro Bidule suivante il faudrait tapez dans la zone 'nom de la macro' : 'Bidule "Marie",1'
Y compris les apostrophe du début et le la fin et là c'est la façon la plus simple car il n'y a pas d'apostrophe ou de guillemet dans la valeur (Marie) à passer au paramètre toto..

VB:

Sub Bidule(toto As String, index As Integer)
    ActiveCell.Value = toto & "_" & index
End Sub

bon apprentissage

Fab117 · 28 Mai 2019

Hello,
Si ça intéresse quelqu'un, en repartant d'une feuille blanche, mais selon la même approche, ça fonctionne parfaitement.
Mes 9 team sites (>1'500 fichiers) sont backupés.
Par contre, je ne sais pas ce qui ne fonctionnait pas dans le code intial.

Fab

XL 2016 Télécharger fichiers sur team site

Fab117

XLDnaute Impliqué

Hasco

XLDnaute Barbatruc

Fab117

XLDnaute Impliqué

Hasco

XLDnaute Barbatruc

Fab117

XLDnaute Impliqué

Hasco

XLDnaute Barbatruc

Fab117

XLDnaute Impliqué

Discussions similaires