IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VB 6 et antérieur Discussion :

Equilibrage du file sytem -> copie de repertoire


Sujet :

VB 6 et antérieur

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Profil pro
    Inscrit en
    Octobre 2004
    Messages
    58
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2004
    Messages : 58
    Par défaut Equilibrage du file sytem -> copie de repertoire
    Bonjour à tous!

    voici ma problèmatique :

    j'ai conçu une application qui me permet de visualiser des documents.

    pour ajouter ces documents à cette application j'ai besoin d'une routine VB qui puisse coller les documents vers un espace du file system(en fait c'est de la copie d'un repertoire vers un autre) que j'appelerai DocServer (serveur de document). Le docserver toi être équilibré (équilibrage des repertoires...)

    voici comment il doit être équilibré :

    il doit y avoir au maximum 10.000 docs par répertoire

    chaque répertoire doit être nommé sur 4 digits "0000"

    les documents ajoutés dans les repertoires doivent être nommé sur 4 digits "0234.doc" et contenir dans leur nom la position du doc dans le repertoire.

    j'imagine que la procédure doit regarder à chaque appel le nombre de documents dans le repertoire courant (si le nombre de doc est supérieur à 10000 alors créé un autre repertoire!et incrémenter son nom...)

    débutant en vb j'aurrai besoin que vous m'orientez sur l'algo et le code de cette fonctionnalité SVP.

    merci pour vos réponses



  2. #2
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Par défaut
    Hello,

    Quand tu dis :
    les documents ajoutés dans les repertoires doivent être nommé sur 4 digits "0234.doc" et contenir dans leur nom la position du doc dans le repertoire
    Les documents sont numérotés de 0000 à 9999... C'est cette numérotation qui doit donner leur position dans le répertoire ou c'est autre chose ?

    Juste pour faire avancer le schmilblic en attendant de voir le pb plus à fond.

    A+

  3. #3
    Membre confirmé
    Profil pro
    Inscrit en
    Octobre 2004
    Messages
    58
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2004
    Messages : 58
    Par défaut
    oui les documents sont numérotés de 0000 à 9999 et c'est cette numérotation qui donne leur place dans le répertoire

  4. #4
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Par défaut
    Je m'aperçois que je t'avais complètement oublié...

    Ils viennent d'où ces documents ? Tu les génères ou faut-il récupérer leur liste quelque part ?

    A+

  5. #5
    Membre confirmé
    Profil pro
    Inscrit en
    Octobre 2004
    Messages
    58
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2004
    Messages : 58
    Par défaut
    en fait il faufrai allez chercher les documents dans un repertoire

  6. #6
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Par défaut
    Bref, tu veux les déplacer et les renommer au passage.
    En VBA depuis Word, ce n'est pas compliqué :
    1 - Créer un répertoire
    2 - Créer un tableau des fichiers du répertoire où se trouvent les fichiers(l'incrémentation se fait ainsi toute seule)
    3 - Soit tu copies les fichiers dans le nouveau répertoire et les renommes après, soit tu renommes et tu transportes

    La fonction Name te permet de renommer les fichiers
    Pour les copiers, la fonction Dos est plus rapide que "ce que je connais" en VBA.
    Pour le nom, NomFich = Right("0000"+cstr(IndexDuTableau),4)+ extension.
    Si IndexDuTableau > 9999 alors création du nouveau répertoire, changement de répertoire, et IndexDuTableau = IndexDuTableau - 9999 pour le nom du fichier
    Etc.

    Dis-nous où tu rencontre un pb

    A+

  7. #7
    Membre confirmé
    Profil pro
    Inscrit en
    Octobre 2004
    Messages
    58
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2004
    Messages : 58
    Par défaut
    ça change quelque chose que j'utilise VB6 plutot que VBA?

    merci pour tes réponses en tout cas

  8. #8
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Par défaut
    Je viens de voir ta question...
    ça change quelque chose que j'utilise VB6 plutot que VBA?
    Ça change que... j'ai pas VB6...
    Mais VBA permet de faire ça.

    A+

  9. #9
    Membre émérite
    Avatar de Theocourant
    Profil pro
    Inscrit en
    Janvier 2005
    Messages
    618
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France

    Informations forums :
    Inscription : Janvier 2005
    Messages : 618
    Par défaut
    Salut,

    Alors je me suis penché sur ton problème et voilà le résultat:
    Dans un module:

    un type
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Public Type RepFic
        NomFic As String 'Nom Fichier
        NomRep As String 'Nom Repertoire
    End Type
    Une fonction:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    Function ControlNomFicRep(monPath As String) As RepFic
    'Fonction de récupération de répertoire et de nom de fichier
    Dim fs, f
    Dim NewDir As Boolean
    Dim SortBoucl As Boolean
    Dim NomFich As String
    Dim NomRep As String
    Dim ValFich As Integer
    Dim ValRep As Integer
     
        Set fs = CreateObject("Scripting.FileSystemObject")
     
        SortBoucl = False
        NewDir = False
     
        For i = 9999 To 0 Step -1
            If i < 10 Then
                If fs.FolderExists(monPath & "000" & CStr(i)) Then
                    For j = 9999 To 0 Step -1
                        If j < 10 Then
                            If fs.FileExists(monPath & "000" & CStr(i) & "\000" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                            If j = 0 And SortBoucl = False Then
                                ValFich = 0
                                ValRep = i
                                SortBoucl = True
                            End If
                        ElseIf j < 100 Then
                            If fs.FileExists(monPath & "000" & CStr(i) & "\00" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        ElseIf j < 1000 Then
                            If fs.FileExists(monPath & "000" & CStr(i) & "\0" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        Else
                            If fs.FileExists(monPath & "000" & CStr(i) & "\" & CStr(j) & ".doc") Then
                                If j = 9999 Then
                                    ValFich = 0
                                    ValRep = i + 1
                                    NewDir = True
                                Else
                                    ValFich = j + 1
                                    ValRep = i
                                End If
                                SortBoucl = True
                            End If
                        End If
                        If SortBoucl Then
                            Exit For
                        End If
                    Next j
                End If
            ElseIf i < 100 Then
                If fs.FolderExists(monPath & "00" & CStr(i)) Then
                    For j = 9999 To 0 Step -1
                        If j < 10 Then
                            If fs.FileExists(monPath & "00" & CStr(i) & "\000" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        ElseIf j < 100 Then
                            If fs.FileExists(monPath & "00" & CStr(i) & "\00" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        ElseIf j < 1000 Then
                            If fs.FileExists(monPath & "00" & CStr(i) & "\0" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        Else
                            If fs.FileExists(monPath & "00" & CStr(i) & "\" & CStr(j) & ".doc") Then
                                If j = 9999 Then
                                    ValFich = 0
                                    ValRep = i + 1
                                    NewDir = True
                                Else
                                    ValFich = j + 1
                                    ValRep = i
                                End If
                                SortBoucl = True
                            End If
                        End If
                        If SortBoucl Then
                            Exit For
                        End If
                    Next j
                End If
            ElseIf i < 1000 Then
                If fs.FolderExists(monPath & "0" & CStr(i)) Then
                    For j = 9999 To 0 Step -1
                        If j < 10 Then
                            If fs.FileExists(monPath & "0" & CStr(i) & "\000" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        ElseIf j < 100 Then
                            If fs.FileExists(monPath & "0" & CStr(i) & "\00" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        ElseIf j < 1000 Then
                            If fs.FileExists(monPath & "0" & CStr(i) & "\0" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        Else
                            If fs.FileExists(monPath & "0" & CStr(i) & "\" & CStr(j) & ".doc") Then
                                If j = 9999 Then
                                    ValFich = 0
                                    ValRep = i + 1
                                    NewDir = True
                                Else
                                    ValFich = j + 1
                                    ValRep = i
                                End If
                                SortBoucl = True
                            End If
                        End If
                        If SortBoucl Then
                            Exit For
                        End If
                    Next j
                End If
            Else
                If fs.FolderExists(monPath & CStr(i)) Then
                    For j = 9999 To 0 Step -1
                        If j < 10 Then
                            If fs.FileExists(monPath & CStr(i) & "\000" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        ElseIf j < 100 Then
                            If fs.FileExists(monPath & CStr(i) & "\00" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        ElseIf j < 1000 Then
                            If fs.FileExists(monPath & CStr(i) & "\0" & CStr(j) & ".doc") Then
                                ValFich = j + 1
                                ValRep = i
                                SortBoucl = True
                            End If
                        Else
                            If fs.FileExists(monPath & CStr(i) & "\" & CStr(j) & ".doc") Then
                                If j = 9999 Then
                                    ValFich = 0
                                    ValRep = i + 1
                                    MsgBox "Erreur repertoires complets", vbCritical + vbOKOnly
                                    End 'Termine l'application
                                Else
                                    ValFich = j + 1
                                    ValRep = i
                                End If
                                SortBoucl = True
                            End If
                        End If
                        If SortBoucl Then
                            Exit For
                        End If
                    Next j
                End If
            End If
            If SortBoucl Then
                Exit For
            End If
            If i = 0 And SortBoucl = False Then
                ValFich = 0
                ValRep = 0
                SortBoucl = True
                NewDir = True
            End If
        Next i
     
        If ValFich < 10 Then
            NomFich = "000" & CStr(ValFich)
        ElseIf ValFich < 100 Then
            NomFich = "00" & CStr(ValFich)
        ElseIf ValFich < 1000 Then
            NomFich = "0" & CStr(ValFich)
        Else
            NomFich = CStr(ValFich)
        End If
     
        If ValRep < 10 Then
            NomRep = "000" & CStr(ValRep)
        ElseIf ValRep < 100 Then
            NomRep = "00" & CStr(ValRep)
        ElseIf ValRep < 1000 Then
            NomRep = "0" & CStr(ValRep)
        Else
            NomRep = CStr(ValRep)
        End If
     
        If NewDir Then
            fs.CreateFolder (monPath & NomRep) 'Création d'un nouveau répertoire
        End If
     
        Set fs = Nothing
     
        ControlNomFicRep.NomFic = NomFich & ".doc"
        ControlNomFicRep.NomRep = NomRep
     
    End Function
    Voici un exmple d'utilisation de la fonction
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    Sub UtiliseFunc()
    Dim monFichier As RepFic
    Dim fs
    Const monPath = "C:\" 'Répertoire pricipal des répertoires 0000 .... 9999
     
        Set fs = CreateObject("Scripting.FileSystemObject")
     
        monFichier = ControlNomFicRep(monPath)
     
        fs.CopyFile "C:\CopyFile.doc", monPath & monFichier.NomRep & "\" & monFichier.NomFic
     
        MsgBox "Terminé"
     
    End Sub
    Le tout piloté par un bouton Command1 sur la form principale:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Private Sub Command1_Click()
        Call UtiliseFunc
    End Sub
    Je sais je sais le code est quasiment pas commenté mais j'ai pas eu le temps de faire plus 8)

    Bonne continuation

    Théo

  10. #10
    Membre confirmé
    Profil pro
    Inscrit en
    Octobre 2004
    Messages
    58
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2004
    Messages : 58
    Par défaut
    Super ta fonction théo

    Par contre quand le repertoire 0000 arrive à 9999 fichiers comment faire pour que le programme créé le repertoire 0001 et commence la copie des fichiers à nouveau à partir de 0000.doc?

    en fait ta fonction (qui est très clair ) ne gère pas le cas ou le repertoire 0000 contient 9999 et fichier et qu'il faut donc passer au 0001

    merci en tout cas j'y vois un peu plus clair!

  11. #11
    Membre émérite
    Avatar de Theocourant
    Profil pro
    Inscrit en
    Janvier 2005
    Messages
    618
    Détails du profil
    Informations personnelles :
    Âge : 47
    Localisation : France

    Informations forums :
    Inscription : Janvier 2005
    Messages : 618
    Par défaut
    Citation Envoyé par soulryo
    Super ta fonction théo

    Par contre quand le repertoire 0000 arrive à 9999 fichiers comment faire pour que le programme créé le repertoire 0001 et commence la copie des fichiers à nouveau à partir de 0000.doc?

    en fait ta fonction (qui est très clair ) ne gère pas le cas ou le repertoire 0000 contient 9999 et fichier et qu'il faut donc passer au 0001

    merci en tout cas j'y vois un peu plus clair!
    Si elle le gère : si un nouveau répertoire doit être entamé, la fonction le crée automatiquement avec le code suivant :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
        If NewDir Then 
            fs.CreateFolder (monPath & NomRep) 'Création d'un nouveau répertoire 
        End If
    Toujours désolé pour le manque de commentaires

    @+

    Théo

  12. #12
    Membre confirmé
    Profil pro
    Inscrit en
    Octobre 2004
    Messages
    58
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Octobre 2004
    Messages : 58
    Par défaut
    En effet ta fonction marche à merveille

    merci

    il faut que je l'adapte maintenant à mon programme!

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. filtre élaboré et copie de repertoire
    Par arnest dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 11/01/2008, 10h18
  2. [ANT] Copie sur repertoire réseau
    Par MrEddy dans le forum ANT
    Réponses: 2
    Dernier message: 15/05/2007, 13h56
  3. [ANT] Copie arborescence repertoire + images
    Par sbernard dans le forum ANT
    Réponses: 2
    Dernier message: 27/02/2007, 11h39
  4. [File] Date de changement d´un Repertoire ou Fichier
    Par bambino78 dans le forum Entrée/Sortie
    Réponses: 7
    Dernier message: 22/02/2007, 09h00
  5. Copie de repertoires recursives sous FTP
    Par EvilAngel dans le forum Développement
    Réponses: 3
    Dernier message: 08/02/2006, 16h35

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo