ajouter fichier pdf dans dossier

reinruof77

XLDnaute Occasionnel
bonjour a tous et toutes

j'ai une petite macro qui me permet de créer des dossier avec le nom et prénom et je voulais savoir si il est possible d'y joindre un fichier pdf choisi.

en gros ajouter le fichier PDF qui ce trouve dans c:/mes documents/toto.pdf dans le dossier truc-much.

Merci de votre aide

Voici ma macro
Code:
Sub CreationRepertoires()
    On Error Resume Next
    i = 1
    While Cells(i, 1).Value <> ""
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        For j = 2 To 11
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
        Next j
        i = i + 1
    Wend
End Sub
sujet poster également sur ce forum
ajouter fichier pdf dans dossier : Excel - VBA
 
Dernière édition:

gilbert_RGI

XLDnaute Barbatruc
Re : ajouter fichier pdf dans dossier

bonjour

comme ceci peut-être

VB:
Sub CreationRepertoires()
    Dim Chemin As String, NouveauChemin As String, Fichier As String
    On Error Resume Next
    i = 1
    While Cells(i, 1).Value <> ""
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        For j = 2 To 11
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
            Chemin = "c:\mes documents\"
            NouveauChemin = ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\"
            Fichier = "toto.pdf"
            Name Chemin & Fichier As NouveauChemin & Fichier    'Copie (attention ce n'est pas une copie mais un déplacement) le fichier vers le nouveau répertoire
        Next j
        i = i + 1
    Wend

End Sub

attention: ce n'est pas une copie mais un déplacement dans un autre répertoire :cool:
 
Dernière édition:

reinruof77

XLDnaute Occasionnel
Re : ajouter fichier pdf dans dossier

Bonjour gilbert_RGI

merci déjà de intéresser a mon problème .

ce que je cherche a faire c'est vraiment le copier car le même fichier pdf peux aller dans plusieurs dossier.

je joint mon fichier Excel et un fichier pdf si certain veulent faire des test .:cool:

Merci encore
 

Pièces jointes

  • creationsrepertoires.xlsm
    24.4 KB · Affichages: 41
  • CRSCGL.zip
    6.9 KB · Affichages: 33

reinruof77

XLDnaute Occasionnel
Re : ajouter fichier pdf dans dossier

Re bonjour

J'ai modifier la macro mais maintenant j'ai deux erreurs
le première : quand la case est vide message d'erreur. comment faire pour passer a la suite
la deuxième : si je n'est pas le fichier. Est il possible d'avoir un message plutôt que ce message désagréable .
voici la Macro modifier
Code:
    Sub CreationRepertoires4()

    'voir à cocher la référence Microsoft Scripting Runtime

        Dim Chemin As String, NouveauChemin As String, Fichier As String
        Dim oFSO As Scripting.FileSystemObject
        Dim oDrv As Scripting.Drive
        'Instanciation du FSO
       Set oFSO = New Scripting.FileSystemObject
       
        On Error Resume Next
        i = 3
        While Cells(i, 1).Value <> ""
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
            On Error GoTo 0
            For j = 2 To 9
               ' If Cells(i, j).Value = "" Then Exit Sub
               MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
                Chemin = "\\xxhy93\donnees\USERS\ISMA2070\Documents\TEST" ' chemin a changer selon
             
                NouveauChemin = ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\"
                          
                If Cells(i, j) <> "" Then
                Fichier1 = Cells(i, j) & ".pdf"
                oFSO.CopyFile Chemin & "\" & Fichier1, NouveauChemin 'copie le fichier
               
              End If
            Next j
            i = i + 1
        Wend
    End Sub

Merci de votre aide
 
Dernière édition:

gilbert_RGI

XLDnaute Barbatruc
Re : ajouter fichier pdf dans dossier

Hello,

je crois que dans la macro il y a une remarque indiquant cette éventualité

il suffit de mettre à la place du nom du PDF l'adresse du nom du fichier ex: Cells(i,?).Value

le ? représentant le n° de la colonne ou se trouve la donnée dans le tableau (ici le nom du PDF)
 

gilbert_RGI

XLDnaute Barbatruc
Re : ajouter fichier pdf dans dossier

oui c'est possible de faire :))
VB:
Sub CreationRepertoires4()

'voir à cocher la référence Microsoft Scripting Runtime
    Dim Chemin As String, NouveauChemin As String, Fichier As String
    Dim oFSO As Scripting.FileSystemObject
    Dim oDrv As Scripting.Drive
    'Instanciation du FSO
    Set oFSO = New Scripting.FileSystemObject
    
    On Error Resume Next
    i = 1
    While Cells(i, 1).Value <> ""
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        For j = 2 To 11
            If Cells(i, j).Value = "" Then Exit Sub
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
            'Chemin = "\\xxhy93\donnees\USERS\ISMA2070\Documents"
            Chemin = "D:\Documents"
            NouveauChemin = ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\"
            If Cells(i, j) <> "" Then
                Fichier1 = Cells(i, j) & ".pdf"
                On Error GoTo suite
                oFSO.CopyFile Chemin & "\" & Fichier1, NouveauChemin 'copie le fichier
                Else
suite:
                ' si tu veux un message sinon tu rem la ligne suivante
                MsgBox "Pas de fichier"
                On Error GoTo 0
                GoTo pass
               
              End If

        Next j
pass:
        i = i + 1
    Wend
End Sub
 
Dernière édition:

gilbert_RGI

XLDnaute Barbatruc
Re : ajouter fichier pdf dans dossier

je pédale un peu car je ne sais pas exactement ce qui doit en résulter

le code fait les dossiers et inclut les fichiers.PDF s'ils existent

tu as mis 11 mais il n'y a que 8 colonnes alors donne moi un peu plus d'explications stp

voilà une autre copie qui fonctionne chez moi

VB:
Sub CreationRepertoires5()

'voir à cocher la référence Microsoft Scripting Runtime
    Dim Chemin As String, NouveauChemin As String, Fichier As String
    Dim oFSO As Scripting.FileSystemObject
    Dim oDrv As Scripting.Drive
    'Instanciation du FSO
    Set oFSO = New Scripting.FileSystemObject
    
    'On Error Resume Next
    i = 1
    While Cells(i, 1).Value <> ""
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        For j = 2 To 8
            If Cells(i, j).Value = "" Then Exit Sub
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
           Chemin = "\\xxhy93\donnees\USERS\ISMA2070\Documents"
            
            NouveauChemin = ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\"
            If Cells(i, j) <> "" Then
                Fichier1 = Cells(i, j) & ".pdf"
                On Error GoTo suite
                oFSO.CopyFile Chemin & "\" & Fichier1, NouveauChemin 'copie le fichier
                Else
                ' si tu veux un message sinon tu rem la ligne suivante
                MsgBox "Pas de fichier :" & Fichier1
              End If
pass:
        Next j
        i = i + 1
    Wend
    Exit Sub
suite:
  MsgBox "Pas de fichier :" & Fichier1
  On Error GoTo 0
  Resume Next
  GoTo pass
    
End Sub
 
Dernière édition:

reinruof77

XLDnaute Occasionnel
Re : ajouter fichier pdf dans dossier

j'ai trouver une solution qui fonctionne.
Code:
 Sub CreationRepertoires() 

    'voir à cocher la référence Microsoft Scripting Runtime

        Dim Chemin As String, NouveauChemin As String, Fichier As String
        Dim oFSO As Scripting.FileSystemObject
        Dim oDrv As Scripting.Drive
        'Instanciation du FSO
       Set oFSO = New Scripting.FileSystemObject

        i = 1
        While Cells(i, 1).Value <> ""
            On Error Resume Next 'si le répertoire existe déjà
           MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
            On Error GoTo 0
            For j = 2 To 10
            'If Cells(i, j).Value <> ""
                On Error Resume Next ' si le répertoire existe déjà
               MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
                On Error GoTo 0
                Chemin = "C:\mes documents\TEST" ' chemin a changer selon
             
                NouveauChemin = ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\"
           
             

                Fichier1 = Cells(i, j) & ".pdf"
               If Dir(Chemin & "\" & Fichier1) <> "" Then
                oFSO.CopyFile Chemin & "\" & Fichier1, NouveauChemin 'copie le fichier
               Else
                'MsgBox "fichier " & fichier1 & " non trouvé"
               End If
              

            Next j
            i = i + 1
        Wend
    End Sub

le seul défaut je dirais que c'est l'apparition du message a chaque fois.

n'est il pas possible qu'il ne s’affiche qu’une seul fois s'il manque le fichier toto.PDF un message seulement et pas a chaque fois?

dans le fichier de base j'ai après contrôle 512 lignes donc 512 clic par fichier manquant.


sinon je supprimerais le message

merci beaucoup pour toute l'aide que tu m'as apporter.:D
 
Dernière édition:

Discussions similaires

Réponses
0
Affichages
83
Réponses
6
Affichages
202