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

Macros et VBA Excel Discussion :

Création de Dossiers et sous dossiers etc [XL-2010]


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Mai 2017
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2017
    Messages : 24
    Points : 18
    Points
    18
    Par défaut Création de Dossiers et sous dossiers etc
    Bonjour à tous,

    Je suis en train de me renseigner sur des bouts de codes afin que je puisse créer des dizaine de centaine de Dossier et sous dossier, dans le but d'archiver correctement les donné que je collecterais plus tard. J'ai trouver un bout de code que j'ai voulu refondre afin qu'il puisse me convenir, mais je pense que je pars dans la mauvaise direction.

    L'arborescence en projet

    .\ (Racine de l'emplacement)
    .\Parc
    .\Parc\Retour
    .\Parc\Pictures\SNP\Year
    .\Parc\RS\SNRS\Year

    Voila pour la structure de ce que je veut faire.

    Problématique

    J'arrive à créer automatiquement le dossier Parc ainsi que ceux de deuxième niveaux (Retour, Picture et RS). J'arrive même à créé le 3eme niveaux de Pictures (SNP). Le soucis est que je n'arrive pas à créer le dossier SNRS qui va dans le dossier RS.


    Le code que j'utilise
    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
    Sub CreationRepertoires()
        On Error Resume Next
        parc = 1
        While Cells(parc, 1).Value <> ""
            MkDir ActiveWorkbook.Path & "\" & Cells(parc, 1).Value
     
            For pic = 2 To 2
                MkDir ActiveWorkbook.Path & "\" & Cells(parc, 1).Value & "\" & Cells(parc, pic).Value
                    For SNP = 5 To 5
                        MkDir ActiveWorkbook.Path & "\" & Cells(parc, 1).Value & "\" & Cells(parc, pic).Value & "\" & Cells(pic, SNP).Value
                    Next SNP
            Next pic
     
            For retour = 3 To 3
                MkDir ActiveWorkbook.Path & "\" & Cells(parc, 1).Value & "\" & Cells(parc, retour).Value
            Next retour
     
            For RS = 4 To 4
                MkDir ActiveWorkbook.Path & "\" & Cells(parc, 1).Value & "\" & Cells(parc, RS).Value
                    For SNRS = 6 To 6
                        MkDir ActiveWorkbook.Path & "\" & Cells(parc, 1).Value & "\" & Cells(parc, RS).Value & "\" & Cells(RS, SNRS).Value
                    Next SNRS
            Next RS
     
     
            parc = parc + 1
        Wend
    End Sub
    Etant débutant, je coince un peu car je n'ai pas l'impression d'avoir une erreur dans le code (par contre c'est clair qu'il ne doit pas être optimiser). Auriez vous des idées de directions à suivre ?

    Merci
    Fichiers attachés Fichiers attachés

  2. #2
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    Juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : Juin 2006
    Messages : 6 132
    Points : 11 274
    Points
    11 274
    Par défaut
    Salut,
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Option Explicit
     
    Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                                 (ByVal hwnd As Long, _
                                                  ByVal pszPath As String, _
                                                  ByVal lngsec As Long) As Long
     
    Private Function CreationDossier(sDossier) As Long
    Dim Rep As Long
        Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
    End Function

  3. #3
    Membre à l'essai
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Mai 2017
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2017
    Messages : 24
    Points : 18
    Points
    18
    Par défaut
    Merci, pour la réponse ultra rapide. Bon par contre, je vais faire F1 sur tout les termes utilisés

  4. #4
    Membre extrêmement actif
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 82
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Points : 12 422
    Points
    12 422
    Par défaut
    Bonjour
    Bon par contre, je vais faire F1 sur tout les termes utilisés
    Ce sera peine perdue.
    Ce qui t'a été montré par kiki29 (que je salue au passage) n'est pas de l'utilisation de VBA, mais celle d'une fonction de l'Api de Windows, appelée et utilisée depuis VBA.
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro ******). Ne m'en proposez donc pas .

    ****** : Non, non ... un classeur .xlsx ne "peut" par exemple et entre autres pas contenir un activex (de surcroît invisible) , "bien sûr" ...

    Il est illusoire de penser que l'on saurait exprimer valablement et précisément en un langage (rigide) de développement ce que l'on peine à exprimer dans le langage naturel, bien plus souple.

  5. #5
    Membre à l'essai
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Mai 2017
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2017
    Messages : 24
    Points : 18
    Points
    18
    Par défaut
    Ha ... oui j'ai trouver beaucoup de retour sur des fichiers .bat en cherchant.

    Mais du coup ça voudrait dire qu'il faudrait appeler des types de commande windows ?

  6. #6
    Membre extrêmement actif
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 82
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Points : 12 422
    Points
    12 422
    Par défaut
    Ha ... oui j'ai trouver beaucoup de retour sur des fichiers .bat en cherchant.
    J'ignore ce que cela veut dire
    Mais du coup ça voudrait dire qu'il faudrait appeler des types de commande windows ?
    J'ignore également ce que pourrait être un "type de commande windows"
    Tes expressions sont pires que du chinois tenté par un scandinave pour moi et n'ont absolument rien à voir avec ce que je t'ai dit, à savoir :
    Ce qui t'a été montré par kiki29 (que je salue au passage) n'est pas de l'utilisation de VBA, mais celle d'une fonction de l'Api de Windows, appelée et utilisée depuis VBA.
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro ******). Ne m'en proposez donc pas .

    ****** : Non, non ... un classeur .xlsx ne "peut" par exemple et entre autres pas contenir un activex (de surcroît invisible) , "bien sûr" ...

    Il est illusoire de penser que l'on saurait exprimer valablement et précisément en un langage (rigide) de développement ce que l'on peine à exprimer dans le langage naturel, bien plus souple.

  7. #7
    Invité
    Invité(e)
    Par défaut
    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
    'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon FalsePublic 
    Function Repertoires_Existe(Repertoires)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Repertoires_Existe = fso.FolderExists(Repertoires)
    Set fso = Nothing
    End Function
    'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
    Public Sub Creer_Repertoires(NewRepertoires)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim t
    Dim R
    Dim I
    R = ""
    t = Split(NewRepertoires & "\", "\")
    For I = 0 To UBound(t) - 1
        If Trim("" & t(I)) <> "" Then
            R = R & Trim("" & t(I))
            If Repertoires_Existe(R) = False Then fso.CreateFolder "" & R
        End If
         R = R & "\"
    Next
    Set fso = Nothing
    End Sub
    Sub test()
    Creer_Repertoires "c:\toto\toto\toto\toto\toto\toto\toto"
    End Sub

  8. #8
    Membre à l'essai
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Mai 2017
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2017
    Messages : 24
    Points : 18
    Points
    18
    Par défaut
    Désolé, de ne pas pouvoir mieux formuler mes phrases, j'essaye de faire au mieux. Mais je m'embrouille peut-être avec tout ce que je trouve comme référence quand je cherche des informations sur se que signifie le code envoyé par kiki29.

  9. #9
    Membre extrêmement actif
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 82
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Points : 12 422
    Points
    12 422
    Par défaut
    je m'embrouille peut-être avec tout ce que je trouve comme référence quand je cherche des informations sur se que signifie le code envoyé par kiki29.
    --->> (entre autres)
    http://allapi.mentalis.org/apilist/S...ectoryEx.shtml
    Et (j'insiste) VBA ne fait que déclarer et 'utiliser dans cette affaire une fonction de l'Api de Windows. Il ne gère rien lui-même.
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro ******). Ne m'en proposez donc pas .

    ****** : Non, non ... un classeur .xlsx ne "peut" par exemple et entre autres pas contenir un activex (de surcroît invisible) , "bien sûr" ...

    Il est illusoire de penser que l'on saurait exprimer valablement et précisément en un langage (rigide) de développement ce que l'on peine à exprimer dans le langage naturel, bien plus souple.

  10. #10
    Membre extrêmement actif Avatar de mjpmjp
    Homme Profil pro
    Retraité
    Inscrit en
    Avril 2012
    Messages
    1 133
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Santé

    Informations forums :
    Inscription : Avril 2012
    Messages : 1 133
    Points : 1 435
    Points
    1 435
    Par défaut
    bonjour,
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
     
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Repertoires_Existe("D:\Parc") = False Then fso.CreateFolder("D:\Parc") 
    If Repertoires_Existe("D:\Parc\Retour") = False Then fso.CreateFolder("D:\Parc\Retour")
    If Repertoires_Existe("D:\Parc\Pictures\SNP\Year") = False Then fso.CreateFolder("D:\Parc\Pictures\SNP\Year") 
    If Repertoires_Existe("D:\Parc\RS\SNRS\Year") = False Then fso.CreateFolder("D:\Parc\RS\SNRS\Year")  
    Set fso = nothing
    ????????????????????????????????????????
    pourquoi toujours ce compliquer la vie ????

    @+JP
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  11. #11
    Membre extrêmement actif
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 82
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Points : 12 422
    Points
    12 422
    Par défaut
    Bonjour mjpmjp
    pourquoi toujours ce compliquer la vie ????
    Ma réponse : qu'est-ce qui te donne à penser que FSO (tout VBS, en fait) n'a pas été délibérément inhibé sur la machine d'accueil ?
    Ton code ne saurait fonctionner sur la mienne (entre autres) et sur de nombreuses machines d'entreprise sur lesquelles est intervenu un responsable sécurité ...
    Je n'accepte pas de demande d' "amitié" individuelle. Tout développeur est pour moi un ami.
    Je n'ouvre AUCUN classeur tiers (avec ou sans macro ******). Ne m'en proposez donc pas .

    ****** : Non, non ... un classeur .xlsx ne "peut" par exemple et entre autres pas contenir un activex (de surcroît invisible) , "bien sûr" ...

    Il est illusoire de penser que l'on saurait exprimer valablement et précisément en un langage (rigide) de développement ce que l'on peine à exprimer dans le langage naturel, bien plus souple.

  12. #12
    Membre à l'essai
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Mai 2017
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2017
    Messages : 24
    Points : 18
    Points
    18
    Par défaut
    Citation Envoyé par unparia Voir le message
    Bonjour mjpmjp

    Ma réponse : qu'est-ce qui te donne à penser que FSO (tout VBS, en fait) n'a pas été délibérément inhibé sur la machine d'accueil ?
    Ton code ne saurait fonctionner sur la mienne (entre autres) et sur de nombreuses machines d'entreprise sur lesquelles est intervenu un responsable sécurité ...
    Non pas que ce code me plait mieux ou pas. Je le comprend mieux en tout cas. Elle fonctionne chez moi après quelques modification . Me reste qu'a le faire fonctionner pour tout les parcs que j'ai. Mais d'un point de vue personnel, je vais continuer a chercher la solution avec le chemin éclairer par kiki29 et unparia.

  13. #13
    Invité
    Invité(e)
    Par défaut
    Citation Envoyé par mjpmjp Voir le message
    bonjour,

    ????????????????????????????????????????
    pourquoi toujours ce compliquer la vie ????

    @+JP
    tu trouve ton truc plus simple et plus réutilisable que
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Sub test()
    Creer_Repertoires "c:\toto\toto\toto\toto\toto\toto\toto"
    End Sub
    
    
    je ne réinvente pas l'eau chaude je recycle!
    Code Module de classe! : 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
    'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
    Public Function Repertoires_Existe(Repertoires)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Repertoires_Existe = fso.FolderExists(Repertoires)
    Set fso = Nothing
    End Function
    'Taille d'un répertoire
    Public Function Taille_Repertoire(Repertoire)
    Dim fso
    Dim Rep
    Set fso = CreateObject("Scripting.FileSystemObject")
        Set Rep = fso.GetFolder(Repertoire)
        Taille_Repertoire = Rep.Size
    End Function
    Function Repertoire_Date_Creation(Repertoire)
      Dim fso
    Dim Rep
    Set fso = CreateObject("Scripting.FileSystemObject")
        Set Rep = fso.GetFolder(Repertoire)
        Repertoire_Date_Creation = Rep.DateCreated
    End Function
    'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
    Public Sub Creer_Repertoires(NewRepertoires)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim t
    Dim R
    Dim I
    R = ""
    t = Split(NewRepertoires & "\", "\")
    For I = 0 To UBound(t) - 1
        If Trim("" & t(I)) <> "" Then
            R = R & Trim("" & t(I))
            If Repertoires_Existe(R) = False Then fso.CreateFolder "" & R
        End If
         R = R & "\"
    Next
    Set fso = Nothing
    End Sub
    'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
    Public Sub Copie_Repertoires(Source, Destination)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFolder Source, Destination, True
    Set fso = Nothing
    End Sub
    'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
    Public Function Deplace_Repertoire(Source, Destination)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    fso.MoveFolder Source, Destination
    If Err > 0 Then Deplace_Repertoire = Err.Description
    Err.Clear
    On Error GoTo 0
    Set fso = Nothing
    End Function
    'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
    Public Sub Supprimer_Repertoire(DelRepertoire)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.DeleteFolder DelRepertoire, True
    Set fso = Nothing
    End Sub
    'Taille d'un répertoire
    Public Function Taille_Fichier(Fichier)
    Dim fso
    Dim Fich
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Fich = fso.GetFile(Fichier)
        Taille_Fichier = Fich.Size
    End Function
    'Vérifie lexistance d'un   fichier
    Public Function Fichier_Exist(Fichier)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Fichier_Exist = fso.FileExists(Fichier)
    Set fso = Nothing
    End Function
    'Retourne le nom du fichier, à partir du chemin d'accès complet précisé en paramètre.
    Public Function Fichier_Name(Fichier)
    Dim fso
    If Fichier_Exist(Fichier) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Fichier_Name = fso.GetBaseName(Fichier)
    Set fso = Nothing
    End If
    End Function
    'Retourne l'extension du fichier, à partir du chemin d'accès complet précisé en paramètre.
    Public Function Fichier_extension(Fichier)
    Dim fso
    If Fichier_Exist(Fichier) = True Then
    Set fso = CreateObject("Scripting.FileSystemObject")
    Fichier_extension = fso.GetExtensionName(Fichier)
    Set fso = Nothing
    End If
    End Function
    'Copie un fichier d'une source vers une destination.
    Public Sub Copie_Fichier(Source, Destination)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.CopyFile Source, Destination, True
    Set fso = Nothing
    End Sub
    'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
    Public Sub Deplace_Fichier(Source, Destination)
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.MoveFile Source, Destination
    Set fso = Nothing
    End Sub
    'Supprime le ou les fichiers dont le nom est précisé en argument.
    Public Sub Supprimer_Fichier(DelFichier)
    If Fichier_Exist(DelFichier) = True Then
    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    fso.DeleteFile DelFichier, True
    Set fso = Nothing
    End If
    End Sub
    Function AppendTxt(sFile, sText)
    Dim fso, NewFichier
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set NewFichier = fso.OpenTextFile(sFile, 8)
    NewFichier.Write sText
    NewFichier.Close
    Set NewFichier = Nothing
    Set fso = Nothing
    End Function
    Public Sub FichierLog(sFile, txt)
    Dim FichierLog, fso
    FichierLog = sFile
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(FichierLog) = False Then EnteteFichier FichierLog
    AppendTxt FichierLog, txt
    Set fso = Nothing
    End Sub
    Private Sub EnteteFichier(Fichier)
    Dim txt, fso, NewFichier
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
    NewFichier.Write txt
    NewFichier.Close
    Set NewFichier = Nothing
    Set fso = Nothing
    End Sub
    Public Function OuvrirFichier(Fichier)
    Set oFs = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFs.OpenTextFile(Fichier)
    OuvrirFichier = Split(oFile.ReadAll, vbCrLf)
    oFile.Close
    End Function

  14. #14
    Membre expert
    Avatar de Igloobel
    Homme Profil pro
    Développeur ERP - VBA et Formateur bureautique
    Inscrit en
    Septembre 2005
    Messages
    1 869
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Loiret (Centre)

    Informations professionnelles :
    Activité : Développeur ERP - VBA et Formateur bureautique
    Secteur : Industrie

    Informations forums :
    Inscription : Septembre 2005
    Messages : 1 869
    Points : 3 442
    Points
    3 442
    Billets dans le blog
    1
    Par défaut
    Bonjour à tous,

    Effectivement, comme le dit Unparia, la solution de kiki29 est vraiment pas mal

    pour ta gouverne et la gestion des fichiers lis ce tutoriel :

    http://warin.developpez.com/access/fichiers/#LI-B-1

    et du coup ce que dit dysorthographie te semblera plus clair

    A+
    Ils ne savaient pas que c'était impossible ... du coup ils l'ont fait (Mark Twain)

    n'oubliez pas de si les messages vous aide ou sont pertinents et de mettre quand cela est !

  15. #15
    Membre extrêmement actif Avatar de mjpmjp
    Homme Profil pro
    Retraité
    Inscrit en
    Avril 2012
    Messages
    1 133
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Hautes Alpes (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Santé

    Informations forums :
    Inscription : Avril 2012
    Messages : 1 133
    Points : 1 435
    Points
    1 435
    Par défaut
    bonjour à tous,

    la réponse de Unparia est une raison valable

    n'étant pas un spécialiste, quand je lis la réponse de kiki29 (que je ne juge pas du tout) avec "Shell32.dll" , moi perso çà fait peur ....non ?

    à part cela , c'est juste pour militer pour la simplicité,...quand c'est possible

    @+JP
    Caractéristiques (WEB) phpMyAdmin 4-74 , PHP 5-631 , Apache 2-427 , MySQL 5-719
    Présentation NAS DS-3615xs + 20Go , DSM 6.1.6-15266 Up1 , 12 * WD 4To WD4000F9YZ (10 raid 6+ )+(2 raid 1+) , LinkSys comutateur-switch lgs528p-eu , Onduleur UPS 720W Power Boxx Lcd (4*UPS + 4*MOD)
    Mes contributions (EXCEL) Form GRAPHIQUE: Gestion des boutons , Liste Onglet dynamique...GESTION de FILM

  16. #16
    Membre à l'essai
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Mai 2017
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2017
    Messages : 24
    Points : 18
    Points
    18
    Par défaut
    Bonjour à tous, (un bon courage à ceux qui ne font pas le pont)

    J'essaye tant bien que mal à comprendre le post de kiki29 mais je me sent larguer.

    J'ai tester le code en y apportant des modification afin qu'il puisse convenir à mon test. Cependant lorsque je le lance rien ne se créer. Je fais certainement quelque chose de mal, mais je ne sais pas vraiment quoi vu que ça reste un peu brumeux pour moi tout ça.

    Avez vous des idées sur le soucis ?

    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
    Option Explicit
     
    Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                                 (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
     
    Sub Test()
     
    Dim i As Long
    Dim sDossier As String
    Dim parc As String
     
    i = 1
            parc = Range("A" & i)
            sDossier = "C:\Users\moi\Desktop\test" & parc
     
                CreationDossier sDossier
     
    End Sub
     
    Private Sub CreationDossier(sDossier As String)
    Dim Rep As Long
        Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
    End Sub

    Edit: j'ai trouvé le soucis et suis en train d'adapter correctement

  17. #17
    Membre à l'essai
    Homme Profil pro
    Technicien maintenance
    Inscrit en
    Mai 2017
    Messages
    24
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Deux Sèvres (Poitou Charente)

    Informations professionnelles :
    Activité : Technicien maintenance
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2017
    Messages : 24
    Points : 18
    Points
    18
    Par défaut
    Re bonjour à tous

    J'ai finalement réussi à mieux comprendre le code en question et du coup réussi à débloquer ma problématique de départ.

    Je partage le code pour que vous puissiez regarder le résultat de votre aide. MERCI à tous ceux qui sont intervenue dans la discussion.

    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
    Option Explicit
     
    Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                                 (ByVal hwnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
     
    Sub Test()
     
    Dim sDossier As String
     
            CreationDossier (sDossier)
     
    End Sub
     
    Private Sub CreationDossier(sDossier As String)
    Dim Rep As Long
    Dim parc As String
    Dim retour As String
    Dim rs As String
    Dim snrs As String
    Dim snp As String
    Dim pictures As String
    Dim year As String
    Dim i As Long
     
    'Etat initiale de la la ligne
    i = 1
     
    'Début de la boucle (je voulais mettre jusqu'a temps que An soit vide mais je ne sais pas faire encore)
    While i < 1000 
     
        'Création des valeurs variables
        parc = Range("A" & i)
        retour = Range("B" & i)
        rs = Range("C" & i)
        pictures = Range("D" & i)
        snp = Range("E" & i)
        snrs = Range("F" & i)
        year = Range("G" & i)
     
     
        'Création de chaque dossiers et sous-dossiers
        sDossier = "C:\Users\moi\Desktop" & "\" & parc
        SHCreateDirectoryEx 0&, sDossier, 0&
     
        sDossier = "C:\Users\moi\Desktop" & "\" & parc & "\" & retour
        SHCreateDirectoryEx 0&, sDossier, 0&
     
        sDossier = "C:\Users\moi\Desktop" & "\" & parc & "\" & rs
        SHCreateDirectoryEx 0&, sDossier, 0&
     
        sDossier = "C:\Users\moi\Desktop" & "\" & parc & "\" & pictures
        SHCreateDirectoryEx 0&, sDossier, 0&
     
        sDossier = "C:\Users\moi\Desktop" & "\" & parc & "\" & pictures & "\" & snp
        SHCreateDirectoryEx 0&, sDossier, 0&
     
        sDossier = "C:\Users\moi\Desktop" & "\" & parc & "\" & rs & "\" & snrs
        SHCreateDirectoryEx 0&, sDossier, 0&
     
        sDossier = "C:\Users\moi\Desktop" & "\" & parc & "\" & pictures & "\" & snp & "\" & year
        SHCreateDirectoryEx 0&, sDossier, 0&
     
        sDossier = "C:\Users\moi\Desktop" & "\" & parc & "\" & rs & "\" & snrs & "\" & year
        SHCreateDirectoryEx 0&, sDossier, 0&
     
        'incrémentation de la ligne
        i = i + 1
     
        Wend
     
        'fin de la boucle
     
    End Sub

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

Discussions similaires

  1. Création de dossier et sous dossier niveau 2 et 3
    Par proumeau dans le forum Macros et VBA Excel
    Réponses: 13
    Dernier message: 05/01/2017, 12h20
  2. Réponses: 6
    Dernier message: 19/10/2009, 18h21
  3. [Répertoire] Création Dossier + 2 sous-dossiers
    Par Strix dans le forum Langage
    Réponses: 2
    Dernier message: 15/01/2007, 13h44
  4. Réponses: 1
    Dernier message: 30/12/2006, 12h14
  5. Réponses: 4
    Dernier message: 25/04/2006, 17h16

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