Use vba Indexes (1 Viewer)

habiler

Registered User.
Local time
Today, 12:01
Joined
Aug 10, 2014
Messages
70
I try to simplify my code using indexes but I have a problem at level
Code:
 MkDir (strPathNl) & newNameA & "\" & newNameA&i

Syntax error.


Code:
Sub RenommerDossier()

 
    'Pr?alable: v?rifier si les r?f?rence n?cessaires au FileSystemObject sont activ?es.
    Dim objFSO As FileSystemObject
    Dim mySource As Object
    Dim Folder As Variant
    Dim newName As String
    Dim strPathNl As String
    Dim strSql As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim i As Long
    toPath = "C:\Pers1"
 
    newNameA = "A. Pieces officielles"
            newNameA1 = "1. P1"
            newNameA2 = "2. Werfbundel"
            newNameA3 = "3. Overige"
            newNameA4 = "4. Contracten"
            newNameA5 = "5. Wijzigingen"
 
    newNameB = "B. Promotions"
 
 
 
    Set dbs = CurrentDb
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder("C:\Pers1\")
    strSql = "SELECT Matr, NomName, NomName,NomNameMatr, Languagecode FROM DEC WHERE Matr = 3500"
    Set rst = dbs.OpenRecordset(strSql, dbOpenSnapshot, dbFailOnError)
 
    strPathNl = toPath & "\" & rst!NomName & "\" '. Pieces officielles\"
 
          If Dir(strPathNl, vbDirectory) = "" Then
 
                 MsgBox "Le r?pertoire n'existe pas"
                 MkDir (strPathNl)
                 MkDir (strPathNl) & newNameA
 
                 For i = 1 To 5
                 i = i + 1
 
                                  MkDir (strPathNl) & newNameA & "\" & newNameA&i & "\"
                                 ' MkDir (strPathNl) & newNameA & "\" & newNameA2 & "\"
                                 ' MkDir (strPathNl) & newNameA & "\" & newNameA3 & "\"
                                 ' MkDir (strPathNl) & newNameA & "\" & newNameA4 & "\"
                                 ' MkDir (strPathNl) & newNameA & "\" & newNameA5 & "\"
                 Next
                 MkDir (strPathNl) & newNameB
         Else
                 MsgBox "Le r?pertoire existe"
         End If
 
 
 
    Set objFSO = New FileSystemObject
    Set mySource = objFSO.GetFolder(strPathNl)
 
 
 
 
    For Each Folder In mySource.SubFolders
        If InStr(1, Folder.Name, "A.") > 0 Then
            If Not Folder.Name Like newName Then
                Folder.Name = newName
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newName Then Folder.Name = newName
            End If
        End If
 
    Next Folder
 
    Set objFSO = Nothing
    Set mySource = Nothing
 
End Sub
[/PHP]
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 19:01
Joined
May 7, 2009
Messages
19,175
is this correct?

strPathNl = toPath & "" & rst!NomName & "" '. Pieces officielles"
 

habiler

Registered User.
Local time
Today, 12:01
Joined
Aug 10, 2014
Messages
70
Yes it's; It's a comment.


For "Pieces officielles" see

Code:
newNameA = "A. Pieces officielles"

            newNameA1 = "1. P1"
            newNameA2 = "2. Werfbundel"
            newNameA3 = "3. Overige"
            newNameA4 = "4. Contracten"
            newNameA5 = "5. Wijzigingen"
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 19:01
Joined
May 7, 2009
Messages
19,175
add space between "&"

MkDir (strPathNl) & newNameA & "\" & newNameA & i
 

habiler

Registered User.
Local time
Today, 12:01
Joined
Aug 10, 2014
Messages
70
How can i obtain this result newNameA1F with

Code:
MkDir (strPathNl) & newNameAF & "\" & newNameA & i & "F" & "\"

Code:
       For i = 1 To 5
       i = i + 1
                 
              MkDir (strPathNl) & newNameAF & "\" & newNameA & i & "F" & "\"
            ' MkDir (strPathNl) & newNameAF & "\" & newNameA2F & "\"
             'MkDir (strPathNl) & newNameAF & "\" & newNameA3F & "\"
             'MkDir (strPathNl) & newNameAF & "\" & newNameA4F & "\"
             'MkDir (strPathNl) & newNameAF & "\" & newNameA5F & "\"
                 
       Next
                 MkDir (strPathNl) & newNameBF
        'Next
                 
         Else
                 MsgBox "Le r?pertoire existe"
         End If
 

jdraw

Super Moderator
Staff member
Local time
Today, 07:01
Joined
Jan 23, 2006
Messages
15,364
Are you getting an error?
You are showing some vba code, but not any symptom(s) of result/issue.

I have a problem at level
What directories/folders do you expect to be created.

Always use OPTION EXPLICIT at top of module.
 
Last edited:

habiler

Registered User.
Local time
Today, 12:01
Joined
Aug 10, 2014
Messages
70
I would like to create the following folders:

newNameA/A. Pieces officielles/1. P1/
newNameA A. Pieces officielles/2. Werfbunde/
newNameA/A. Pieces officielles/3. Overige/
newNameA/A. Pieces officielles/4. Contracten/
newNameA/A. Pieces officielles/5. Wijzigingen/

Code:
    newNameAF = "A. Pieces officielles de recrutement"
    
            newNameA1F = "1. P1"
            newNameA2F = "2. Recueil de travail"
            newNameA3F = "3. Autre"
            newNameA4F = "4. Contrats"
            newNameA5F = "5. Amendements"


      For i = 1 To 5 ( = /1. P1-> /5. Wijzigingen)
       i = i + 1
                 
                                        A. Pieces officielles      1. P1-> 5. Wijzigingen
      
              MkDir (strPathNl) & newNameAF & "\" & newNameA & i & "F" & "\"
            ' MkDir (strPathNl) & newNameAF & "\" & newNameA2F & "\"
             'MkDir (strPathNl) & newNameAF & "\" & newNameA3F & "\"
             'MkDir (strPathNl) & newNameAF & "\" & newNameA4F & "\"
             'MkDir (strPathNl) & newNameAF & "\" & newNameA5F & "\"
                 
       Next
      ............
                 
         Else
                 MsgBox "Le répertoire existe"
         End If
 

moke123

AWF VIP
Local time
Today, 07:01
Joined
Jan 11, 2013
Messages
3,852
If your trying to create empty subfolders in your directory I would suggest something like -


Code:
    Dim Pth As String
    Dim varFldrs As Variant
    Dim i As Integer

    Pth = "C:\Pers1\"  'Path to the top folder

    varFldrs = Split("1. P1,2. Werfbundel,3. Overige,4. Contracten,5. Wijzigingen", ",")

    For i = 0 To UBound(varFldrs)

        If Len(Dir(Pth & varFldrs(i), vbDirectory)) = 0 Then

            MkDir Pth & varFldrs(i)

        End If

    Next i
 

habiler

Registered User.
Local time
Today, 12:01
Joined
Aug 10, 2014
Messages
70
How can I do the same with the subfolder in A.
Check if the spelling of the directory is correct?
Can I use
Code:
 varFldrs = Split("1. P1,2. Werfbundel,3. Overige,4. Contracten,5. Wijzigingen", ",")
?

Code:
If InStr(1, Folder.Name, "A.") > 0 Then
                  If Not Folder.Name Like newNameAF Then
                     Folder.Name = newNameAF
      'check if you do not process the same directory more than once!!
                    If Folder.Name <> newNameAF Then Folder.Name = newNameAF
                End If
 End If
 

moke123

AWF VIP
Local time
Today, 07:01
Joined
Jan 11, 2013
Messages
3,852
to be honest I'm not sure i grasp exactly what you want to do.

you have a folder- "C:\Pers1"
you open a 1 record recordset to get "NomName" for example "John"
you want to make a new folder named "John" in "C:\Pers1" so it is "C:\Pers1\John"
you then want to make the 5 subfolders in "C:\Pers1\John"
you want a folder "B. Promotions" in "C:\Pers1" '< this one confuses me

is the above correct?

I dont understand the following part. whats its purpose?

Code:
For Each Folder In mySource.SubFolders
        If InStr(1, Folder.Name, "A.") > 0 Then
            If Not Folder.Name Like newName Then
                Folder.Name = newName
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newName Then Folder.Name = newName
            End If
        End If
 
    Next Folder

if my assumptions are correct you can do something like
Code:
Sub sRootFolders()

    Dim Pth As String
    Dim Root1 As String, Root2 As String
    Dim NewName As String
    Dim varFldrs As Variant
    Dim i As Integer
    
    Pth = "C:\Pers1\"  'Path to the top folder with trailing slash
    NewName = DLookup("NomName", "DEC", "Matr = 3500") & "\"
    
    Root1 = Pth & NewName
    Root2 = Pth & "B. Promotions"

    If Len(Dir(Root1, vbDirectory)) = 0 Then

        MkDir Root1

    End If

    If Len(Dir(Root2, vbDirectory)) = 0 Then

        MkDir Root2

    End If
  
    varFldrs = Split("1. P1,2. Werfbundel,3. Overige,4. Contracten,5. Wijzigingen", ",")

    For i = 0 To UBound(varFldrs)

        If Len(Dir(Root1 & varFldrs(i), vbDirectory)) = 0 Then

            MkDir Root1 & varFldrs(i)

        End If

    Next i
 
End Sub
 

habiler

Registered User.
Local time
Today, 12:01
Joined
Aug 10, 2014
Messages
70
Actually I have a directory
C: Pers1 Name
A. Hello to K. Goodby
With subfolders
A. Hello "1. P1,2. Werfbundel,3. Overige,4. Contracten,5. Wijzigingen"

With the code below I would like to check if all existing drectory are well spelled.If not correct them (see "1. P1,....,5. Wijzigingen") or create them if not exists.

Code:
If InStr(1, Folder.Name, "A.") > 0 Then
                  If Not Folder.Name Like newNameAF Then
                     Folder.Name = newNameAF
      'check if you do not process the same directory more than once!!
                    If Folder.Name <> newNameAF Then Folder.Name = newNameAF
                End If
 End If
 

moke123

AWF VIP
Local time
Today, 07:01
Joined
Jan 11, 2013
Messages
3,852
Its hard to give you a targeted response when you keep changing what your existing data reflects. We can only see what you post.
Actually I have a directory
C: Pers1 Name
A. Hello to K. Goodby
With subfolders
A. Hello "1. P1,2. Werfbundel,3. Overige,4. Contracten,5. Wijzigingen"

So is the top directory "C: Pers1 Name" or "C: Pers1\ Name" with name being the variable from NomName?

should the directory structure look like...
C: Pers1 Name\A. Hello to K. Goodby
C: Pers1 Name\A. Hello to K. Goodby\A. Hello
C: Pers1 Name\A. Hello to K. Goodby\1. P1
C: Pers1 Name\A. Hello to K. Goodby\2. Werfbundel
C: Pers1 Name\A. Hello to K. Goodby\3.Overige
C: Pers1 Name\A. Hello to K. Goodby\4. Contracten
C: Pers1 Name\A. Hello to K. Goodby\5. Wijzigingen"

what parts are static and what parts are dynamic? and where do dynamic parts come from? whats NomName?

Are there existing folders you need to rename? if so, How do you determine which ones and how they are spelled wrong?
 

jdraw

Super Moderator
Staff member
Local time
Today, 07:01
Joined
Jan 23, 2006
Messages
15,364
???I agree with moke re lack of clarity in the requirement.

I would like to check if all existing drectory are well spelled.
Why wouldn't you do this spell check thoroughly before running code?

I recommend you do some research on problem solving and debugging techniques. You can make use of the Debug.Print statement to see how the vba will be rendered before ever executing changes to your directories.
Good luck.
 

habiler

Registered User.
Local time
Today, 12:01
Joined
Aug 10, 2014
Messages
70
Here is my full code.
I would like that by employee there is a tree as listed under Tree.gif
NomName is issued from an access DB. There are two langages .

Not all subfolders are present or misspelled.

Do you want more information


Code:
Option Compare Database

Sub RenommerDossier()
'si les dossiers comportant \A.
'mais ne s'intitulant pas \A. Pieces officielles\"
'soient remplacés par \A. Pieces officielles\"
 
    'Préalable: vérifier si les référence nécessaires au FileSystemObject sont activées.
    Dim objFSO As FileSystemObject
    Dim mySource As Object
    Dim Folder As Variant
    Dim newName As String
    Dim strPathNl As String
    Dim strSql As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim i As Long
    toPath = "C:\Pers1"
    
    newNameAF = "A. Pieces officielles de recrutement"
    newNameAN = "A. Officiele aanwervingsstukkken"
            newNameA1N = "1. P1"
            newNameA1F = "1. P1"
            newNameA2N = "2. Werfbundel"
            newNameA2F = "2. Recueil de travail"
            newNameA3N = "3. Overige"
            newNameA3F = "3. Autre"
            newNameA4N = "4. Contracten"
            newNameA4F = "4. Contrats"
            newNameA5N = "5. Wijzigingen"
            newNameA5F = "5. Amendements"
    
    newNameBF = "B. Promotions"
            
            newNameB1F = "1. Nominations"
            newNameB2F = "2. Rapport périodes d'essai"
            newNameB3F = "3. Mandats"
            newNameB4F = "4. Fonctions supérieures"
            newNameB5F = "5. Car Policy"
            newNameB6F = "6. Rapports de stage"
            newNameB7F = "7. Réaffectation"
            newNameB8F = "8. Autres"
            
 newNameBN = "B. Benoemingen"
 
            newNameB1N = "1. Benoemingen"
            newNameB2N = "2. Verslag preofperiodes"
            newNameB3N = "3. Mandaten"
            newNameB4N = "4. Hogere functies"
            newNameB5N = "5. Car Policy"
            newNameB6N = "6. Stage rapporten"
            newNameB7N = "7. Réaffectatie"
            newNameB8N = "8. overige"
    
    newNameCN = "C. Overplaatsingen"
    newNameCF = "C. Transferts"
    
    newNameDN = "D. Examens"
    newNameDF = "D. Examens"
    
            newNameD1N = "1. Certificaten,opleidingen"
            newNameD1F = "1. Certificats, formations"
            newNameD2N = "2. Examenfolders, resultaten"
            newNameD2F = "2. Cahiers d'examens, résultats"
            newNameD3N = "3. Thesissen"
            newNameD3F = "3. Thèses"
            newNameD4N = "4. Overige"
            newNameD4F = "4. Autre"
            
    newNameEN = "E. Notificaties"
    newNameEF = "E. Notifications"
                
                
    newNameFN = "F. Afwezigheden en verloven"
    
                newNameF1N = "1. Loopbaanonderbreking"
                newNameF2N = "2. Ziekteverlof"
                newNameF3N = "3. Arbeidsongeval"
                newNameF4N = "4. Detachering"
                newNameF5N = "5. Ouderschapsverlof"
                newNameF6N = "6. Medische bijstand"
                newNameF7N = "7. Familiaal verlof"
                newNameF8N = "8. Palliatieve zorgen"
                newNameF9N = "9. Educatief verlof"
                newNameF10N = "10. Verlof zonder wedde"
                newNameF11N = "11. Verminderd prestaties"
                newNameF12N = "12. Overige"
               
     newNameFF = "F. Absences et congés"
     
                newNameF1F = "1. Interruption de carrière"
                newNameF2F = "2. Maladie"
                newNameF3F = "3. Accident de travail"
                newNameF4F = "4. Détachement"
                newNameF5F = "5. Congé Parental"
                newNameF6F = "6. Assistance médicale"
                newNameF7F = "7. Congé familial"
                newNameF8F = "8. Soins palliatifs"
                newNameF9F = "9. Congé éducatif"
                newNameF10F = "10. Congé sans solde"
                newNameF11F = "11. Prestations réduites"
                newNameF12F = "\12. Autres\"
                

    newNameGF = "G. Requêtes personnelles"
    
                newNameG1F = "1. Attestations"
                newNameG2F = "2. Cumul"
                newNameG3F = "3. Télétravail"
                newNameG4F = "4. Retenue sur traitement"
                newNameG5F = "5. Autres"
                
    newNameGN = "\G. Persoonlijke verzoekschriften\"

                newNameG1N = "1. Attesten"
                newNameG2N = "2. Cumul"
                newNameG3N = "3. Thuiswerk"
                newNameG4N = "4. Loonbeslag"
                newNameG5N = "5. Overige"
                
                
    newNameHF = "H. Assurances"
    newNameHN = "H. verzekeringen"
    newNameIF = "I. Punitions"
    newNameIN = "I. Straffen"
    newNameJF = "J. Fin de contrat"
    newNameJN = "J. Eind contract"
    newNameKF = "K. Différends juridiques"
    newNameKN = "K. Différends juridiques"
    
     

    Set dbs = CurrentDb
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder("C:\Pers1\")
    strSql = "SELECT Matr, NomName, NomName,NomNameMatr, Languagecode FROM DEC WHERE Matr = 3478"
    Set rst = dbs.OpenRecordset(strSql, dbOpenSnapshot, dbFailOnError)
    
    strPathNl = toPath & "\" & rst!NomName & "\" '. Pieces officielles\"
    Dim Pth As String
    Dim varFldrs As Variant
    'Dim i As Integer

    'Pth = "C:\Pers1\"  'Path to the top folder

   ' varFldrs = Split("1. P1,2. Werfbundel,3. Overige,4. Contracten,5. Wijzigingen", ",")

   ' For i = 0 To UBound(varFldrs)

   '     If Len(Dir(strPathNl & varFldrs(i), vbDirectory)) = 0 Then

   '         MkDir strPathNl & varFldrs(i)

   '     End If

   ' Next i
    '      If Dir(strPathNl, vbDirectory) = "" Then
    '      MsgBox "Le répertoire n'existe pas"
       '          MkDir (strPathNl)
    '             MkDir (strPathNl) & newNameAF

 
 
    Set objFSO = New FileSystemObject
    Set mySource = objFSO.GetFolder(strPathNl)



 
    For Each Folder In mySource.SubFolders
        If InStr(1, Folder.Name, "A.") > 0 Then
            If Not Folder.Name Like newNameAF Then
                Folder.Name = newNameAF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameAF Then Folder.Name = newNameAF
           ' End If
           

        End If
        
             If InStr(1, Folder.Name, "B.") > 0 Then
             If Not Folder.Name Like newNameBF Then
                Folder.Name = newNameBF
                'check if you do not process the same directory more than once!!
                If Folder.Name <> newNameBF Then Folder.Name = newNameBF
            End If
        End If
                If InStr(1, Folder.Name, "C.") > 0 Then
            If Not Folder.Name Like newNameCF Then
                Folder.Name = newNameCF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameCF Then Folder.Name = newNameCF
            End If
        End If
             If InStr(1, Folder.Name, "D.") > 0 Then
             If Not Folder.Name Like newNameDF Then
                Folder.Name = newNameDF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameDF Then Folder.Name = newNameDF
            End If
        End If
        
           
        
                If InStr(1, Folder.Name, "E.") > 0 Then
            If Not Folder.Name Like newNameEF Then
                Folder.Name = newNameEF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameEF Then Folder.Name = newNameEF
            End If
        End If
        
             If InStr(1, Folder.Name, "F.") > 0 Then
             If Not Folder.Name Like newNameFF Then
                Folder.Name = newNameFF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameFF Then Folder.Name = newNameFF
            End If
        End If
                If InStr(1, Folder.Name, "G.") > 0 Then
            If Not Folder.Name Like newNameGF Then
                Folder.Name = newNameGF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameGF Then Folder.Name = newNameGF
            End If
        End If
             If InStr(1, Folder.Name, "H.") > 0 Then
             If Not Folder.Name Like newNameHF Then
                Folder.Name = newNameHF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameHF Then Folder.Name = newNameHF
            End If
        End If
        
                
             If InStr(1, Folder.Name, "I.") > 0 Then
             If Not Folder.Name Like newNameIF Then
                Folder.Name = newNameIF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameIF Then Folder.Name = newNameIF
            End If
        End If
                If InStr(1, Folder.Name, "J.") > 0 Then
            If Not Folder.Name Like newNameJF Then
                Folder.Name = newNameJF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameJF Then Folder.Name = newNameJF
            End If
        End If
             If InStr(1, Folder.Name, "K.") > 0 Then
             If Not Folder.Name Like newNameKF Then
                Folder.Name = newNameKF
                'vérifier si l'on ne traite pas le même répertoire plus d'une fois !!
                If Folder.Name <> newNameKF Then Folder.Name = newNameKF
            End If
        End If
         End If
     '    End If
    Next

    Set objFSO = Nothing
    Set mySource = Nothing
 
End Sub
 

Attachments

  • Tree.GIF
    Tree.GIF
    29.4 KB · Views: 99

moke123

AWF VIP
Local time
Today, 07:01
Joined
Jan 11, 2013
Messages
3,852
Habiler,

EDIT: It appears you posted while I was writing this. I want to make it clear to you that you must declare Option Explicit at the top of every module under Option Compare Database

Code:
Option Compare Database
Option Explicit
You will see that your code will not compile when you do as you have not declared all your variables and will get inconsistant results.

With the code I wrote it checks for an existing folder before creating one. If the folder exists it does not create a new one. If there is an existing folder which is spelled incorrectly it will still create a new folder with the spelling contained in the code.
One way I imagine you could identify folders which contain a mispelled folder is to do a count of the folders within the folder. So if there are supposed to be 6 subfolders and you get a count greater than that you know there was an existing folder not named or spelled the same as in the given code.

You can return a count with a function like...
Code:
Public Function fFolderCount(Fpath As String) As Long

    Dim oFSO As Object
    Dim folder As Object
    Dim subfolders As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set folder = oFSO.GetFolder(Fpath)
    Set subfolders = folder.subfolders

    fFolderCount = subfolders.Count

    Set oFSO = Nothing
    Set folder = Nothing
    Set subfolders = Nothing
  
End Function

In order to perform these kinds of tasks there has to be a set of rules to follow and those rules need to be consistant and repeatable. Try to foresee any deviances from the rules and anticipate and incorporate them.

It may also help if you gave us a description of the purpose of your database and what these folders are for.

If there are existing folders to be renamed, how many are there and will correcting them be a one-off solution or will it need to be done on a continuing basis?

hth
 
Last edited:

moke123

AWF VIP
Local time
Today, 07:01
Joined
Jan 11, 2013
Messages
3,852
Your post shows quite alot more than your OP.

I noted in your code you have folders ...
Code:
            newNameD1N = "1. Certificaten,opleidingen"
            newNameD1F = "1. Certificats, formations"
            newNameD2N = "2. Examenfolders, resultaten"
            newNameD2F = "2. Cahiers d'examens, résultats"
Note that the commas contained in the folder names will break the code I gave you. Also having slashes ( newNameF12F = "\12. Autres") will be problamatic.
 

habiler

Registered User.
Local time
Today, 12:01
Joined
Aug 10, 2014
Messages
70
Now I have an error at line

Code:
 Set FSO = FSO.GetFolder("C:\Pers1\")

Error 13, compatiblity type

Code:
Option Compare Database
Option Explicit

Sub RenommerDossier()
'si les dossiers comportant \A.
'mais ne s'intitulant pas \A. Pieces officielles\"
'soient remplac?s par \A. Pieces officielles\"
 
    'Pr?alable: v?rifier si les r?f?rence n?cessaires au FileSystemObject sont activ?es.
    Dim FSO As FileSystemObject
    Dim mySource As Object
    Dim Folder As Variant
    Dim newName As String
    Dim strPathNl As String
    Dim strSql As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
   ' Dim i As Long
    Dim toPath As String
    toPath = "C:\Pers1"
    Dim newNameAF As String, newNameAN As String, newNameA1N As String, newNameA1F As String, newNameA2N As String, newNameA2F As String, newNameA3N As String, newNameA3F As String, newNameA4N As String, newNameA4F As String, newNameA5N As String, newNameA5F As String
    Dim newNameBF As String, newNameBN As String, newNameB1N As String, newNameB1F As String, newNameB2N As String, newNameB2F As String, newNameB3N As String, newNameB3F As String, newNameB4N As String, newNameB4F As String, newNameB5N As String, newNameB5F As String, newNameB6N As String, newNameB6F As String, newNameB7N As String, newNameB7F As String, newNameB8N As String, newNameB8F As String
    Dim newNamecF As String, newNamecN As String, newNamedF As String, newNameDN As String, newNameD1N As String, newNameD1F As String, newNameD2N As String, newNameD2F As String, newNameD3N As String, newNameD3F As String, newNameD4N As String, newNameD4F As String
    Dim newNameEF As String, newNameEN As String, newNameFF As String, newNameFN As String, newNameF1n As String, newNameF1F As String, newNameF2N As String, newNameF2F As String, newNameF3N As String, newNameF3F As String, newNameF4N As String, newNameF4F As String, newNameF5N As String, newNameF5F As String, newNameF6N As String, newNameF6F As String, newNameF7N As String, newNameF7F As String, newNameF8f As String, newNameF8N As String, newNameF9N As String, newNameF9F As String, newNameF10N As String, newNameF10F As String, newNameF11N As String, newNameF11F As String, newNameF12N As String, newNameF12F As String
    Dim newNameGF As String, newNameGN As String, newNameG1N As String, newNameG1F As String, newNameG2N As String, newNameG2F As String, newNameG3N As String, newNameG3F As String, newNameG4N As String, newNameG4F As String, newNameG5N As String, newNameG5F As String
    Dim newNameHF As String, newNameHN, newNameIF As String, newNameIN As String, newNameJF As String, newNameJN As String, newNamekF As String, newNameKN As String
    newNameAF = "A. Pieces officielles de recrutement"
    newNameAN = "A. Officiele aanwervingsstukkken"
            newNameA1N = "1. P1"
            newNameA1F = "1. P1"
            newNameA2N = "2. Werfbundel"
            newNameA2F = "2. Recueil de travail"
            newNameA3N = "3. Overige"
            newNameA3F = "3. Autre"
            newNameA4N = "4. Contracten"
            newNameA4F = "4. Contrats"
            newNameA5N = "5. Wijzigingen"
            newNameA5F = "5. Amendements"
    
    newNameBF = "B. Promotions"
            
            newNameB1F = "1. Nominations"
                      
            newNameB2F = "2. Rapport p?riodes d'essai"

            newNameB3F = "3. Mandats"

            newNameB4F = "4. Fonctions sup?rieures"
            
            newNameB5F = "5. Car Policy"
            
            newNameB6F = "6. Rapports de stage"
            
            newNameB7F = "7. R?affectation"
            
            newNameB8F = "8. Autres"
            
 newNameBN = "B. Benoemingen"
 
            newNameB1N = "1. Benoemingen"
            newNameB2N = "2. Verslag preofperiodes"
            newNameB3N = "3. Mandaten"
            newNameB4N = "4. Hogere functies"
            newNameB5N = "5. Car Policy"
            newNameB6N = "6. Stage rapporten"
            newNameB7N = "7. R?affectatie"
            newNameB8N = "8. overige"
    
    newNamecN = "C. Overplaatsingen"
    newNamecF = "C. Transferts"
    
    newNameDN = "D. Examens"
    newNamedF = "D. Examens"
    
            newNameD1N = "1. Certificaten,opleidingen"
            newNameD1F = "1. Certificats, formations"
            newNameD2N = "2. Examenfolders, resultaten"
            newNameD2F = "2. Cahiers d'examens, r?sultats"
            newNameD3N = "3. Thesissen"
            newNameD3F = "3. Th?ses"
            newNameD4N = "4. Overige"
            newNameD4F = "4. Autre"
            
    newNameEN = "E. Notificaties"
    newNameEF = "E. Notifications"
                
                
    newNameFN = "F. Afwezigheden en verloven"
    
                newNameF1n = "1. Loopbaanonderbreking"
                newNameF2N = "2. Ziekteverlof"
                newNameF3N = "3. Arbeidsongeval"
                newNameF4N = "4. Detachering"
                newNameF5N = "5. Ouderschapsverlof"
                newNameF6N = "6. Medische bijstand"
                newNameF7N = "7. Familiaal verlof"
                newNameF8N = "8. Palliatieve zorgen"
                newNameF9N = "9. Educatief verlof"
                newNameF10N = "10. Verlof zonder wedde"
                newNameF11N = "11. Verminderd prestaties"
                newNameF12N = "12. Overige"
               
     newNameFF = "F. Absences et cong?s"
     
                newNameF1F = "1. Interruption de carri?re"

                newNameF2F = "2. Maladie"
                            
                newNameF3F = "3. Accident de travail"

                newNameF4F = "4. D?tachement"
       
                newNameF5F = "5. Cong? Parental"
   
                newNameF6F = "6. Assistance m?dicale"
        
                newNameF7F = "7. Cong? familial"
       
                newNameF8f = "8. Soins palliatifs"
                       
                newNameF9F = "9. Cong? ?ducatif"
         
                newNameF10F = "10. Cong? sans solde"
   
                newNameF11F = "11. Prestations r?duites"

                newNameF12F = "\12. Autres\"
                

    newNameGF = "G. Requ?tes personnelles"
    
                newNameG1F = "1. Attestations"
                newNameG2F = "2. Cumul"
                newNameG3F = "3. T?l?travail"
                newNameG4F = "4. Retenue sur traitement"
                newNameG5F = "5. Autres"
                
    newNameGN = "\G. Persoonlijke verzoekschriften\"

                newNameG1N = "1. Attesten"
                
                newNameG2N = "2. Cumul"
                            
                newNameG3N = "3. Thuiswerk"
           
                newNameG4N = "4. Loonbeslag"
                            
                newNameG5N = "5. Overige"
                
                
    newNameHF = "H. Assurances"
    newNameHN = "H. verzekeringen"
    newNameIF = "I. Punitions"
    newNameIN = "I. Straffen"
    newNameJF = "J. Fin de contrat"
    newNameJN = "J. Eind contract"
    newNamekF = "K. Diff?rends juridiques"
    newNameKN = "K. Diff?rends juridiques"
    
     

    Set dbs = CurrentDb
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set FSO = FSO.GetFolder("C:\Pers1\")
    
    strSql = "SELECT Matr, NomName, NomName,NomNameMatr, Languagecode FROM DEC WHERE Matr = 3478"
    Set rst = dbs.OpenRecordset(strSql, dbOpenSnapshot, dbFailOnError)
    
    strPathNl = toPath & "\" & rst!NomName & "\" '. Pieces officielles\"
    Dim Pth As String
    Dim varFldrs As Variant
    Dim i As Integer

    'Pth = "C:\Pers1\"  'Path to the top folder

   varFldrs = Split("1. P1,2. Werfbundel,3. Overige,4. Contracten,5. Wijzigingen", ",")

   ' For i = 0 To UBound(varFldrs)

   '     If Len(Dir(strPathNl & varFldrs(i), vbDirectory)) = 0 Then

   '         MkDir strPathNl & varFldrs(i)

   '     End If

   ' Next i
    '      If Dir(strPathNl, vbDirectory) = "" Then
    '      MsgBox "Le r?pertoire n'existe pas"
       '          MkDir (strPathNl)
    '             MkDir (strPathNl) & newNameAF

 
 
    Set FSO = New FileSystemObject
    Set mySource = FSO.GetFolder(strPathNl)

If Not InStr(1, strPathNl, "A.") Then MkDir strPathNl & newNameAF
   
   For i = 0 To UBound(varFldrs)

       If Len(Dir(strPathNl & varFldrs(i), vbDirectory)) = 0 Then

           MkDir strPathNl & "\" & varFldrs(i)

       End If

   Next i
 
    For Each Folder In mySource.SubFolders
         
        If InStr(1, Folder.Name, "A.") > 0 Then
            If Not Folder.Name Like newNameAF Then
                Folder.Name = newNameAF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNameAF Then Folder.Name = newNameAF
           ' End If
           

        End If
        
             If InStr(1, Folder.Name, "B.") > 0 Then
             If Not Folder.Name Like newNameBF Then
                Folder.Name = newNameBF
                'check if you do not process the same directory more than once!!
                If Folder.Name <> newNameBF Then Folder.Name = newNameBF
            End If
        End If
                If InStr(1, Folder.Name, "C.") > 0 Then
            If Not Folder.Name Like newNamecF Then
                Folder.Name = newNamecF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNamecF Then Folder.Name = newNamecF
            End If
        End If
             If InStr(1, Folder.Name, "D.") > 0 Then
             If Not Folder.Name Like newNamedF Then
                Folder.Name = newNamedF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNamedF Then Folder.Name = newNamedF
            End If
        End If
        
           
        
                If InStr(1, Folder.Name, "E.") > 0 Then
            If Not Folder.Name Like newNameEF Then
                Folder.Name = newNameEF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNameEF Then Folder.Name = newNameEF
            End If
        End If
        
             If InStr(1, Folder.Name, "F.") > 0 Then
             If Not Folder.Name Like newNameFF Then
                Folder.Name = newNameFF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNameFF Then Folder.Name = newNameFF
            End If
        End If
                If InStr(1, Folder.Name, "G.") > 0 Then
            If Not Folder.Name Like newNameGF Then
                Folder.Name = newNameGF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNameGF Then Folder.Name = newNameGF
            End If
        End If
             If InStr(1, Folder.Name, "H.") > 0 Then
             If Not Folder.Name Like newNameHF Then
                Folder.Name = newNameHF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNameHF Then Folder.Name = newNameHF
            End If
        End If
        
                
             If InStr(1, Folder.Name, "I.") > 0 Then
             If Not Folder.Name Like newNameIF Then
                Folder.Name = newNameIF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNameIF Then Folder.Name = newNameIF
            End If
        End If
                If InStr(1, Folder.Name, "J.") > 0 Then
            If Not Folder.Name Like newNameJF Then
                Folder.Name = newNameJF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNameJF Then Folder.Name = newNameJF
            End If
        End If
             If InStr(1, Folder.Name, "K.") > 0 Then
             If Not Folder.Name Like newNamekF Then
                Folder.Name = newNamekF
                'v?rifier si l'on ne traite pas le m?me r?pertoire plus d'une fois !!
                If Folder.Name <> newNamekF Then Folder.Name = newNamekF
            End If
        End If
         End If
     '    End If
    Next

    Set FSO = Nothing
    Set mySource = Nothing
 
End Sub
 

habiler

Registered User.
Local time
Today, 12:01
Joined
Aug 10, 2014
Messages
70
What's wrong with my code.

Code:
Root2 & "\" & varFldrsRoot1(i)
is not created.


Code:
Option Compare Database
Option Explicit

Sub Verifier_Presence_Sous_Dossier()
    Dim Pth As String
    Dim i As Integer
    Dim strSql As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim fs As FileSystemObject
    Dim mySource As Object
    Dim Folder As Variant
    Dim fso As Object
    Set dbs = CurrentDb
    Dim Root1 As String, Root2 As String, Root3 As String
    Dim NewName As String
    Dim varFldrsRoot1 As Variant
    
    Set dbs = CurrentDb
    strSql = "SELECT DEC.Matr, DEC.NomName, DEC.NomNameMatr, DEC.NomNameMatrk, DEC.Languagecode FROM [DEC] WHERE (((DEC.Languagecode)=0) AND ((DEC.[Matr])= 5676));" 'Or (DEC.[Matr])=105185 Or (DEC.[Matr])=5363));"
    Set rst = dbs.OpenRecordset(strSql, dbOpenSnapshot, dbFailOnError)
    
    Pth = "F:\Pers\"  'Path to the top folder with trailing slash
  
    
    Root1 = Pth & rst!NomName
    Root2 = Root1 & "\" & "J. Fin du contrat"
    'Root3 = Root1 & "B. Promotions"

    If Len(Dir(Root1, vbDirectory)) = 0 Then

        MkDir Root1

    End If

    If Len(Dir(Root2, vbDirectory)) = 0 Then

        MkDir Root2

    End If
  
    varFldrsRoot1 = Split("1. Dispo retraite anticipée et rappel en service,2. Pension,3. demission,4. Fiche B2,5. Autre", ",")

    For i = 0 To UBound(varFldrsRoot1)

        If Len(Dir(Root2 & "\" & varFldrsRoot1(i), vbDirectory)) = 0 Then
               
        MkDir Root2 & "\" & varFldrsRoot1(i) & "\"
        End If
  Next i
 
End Sub
 

Users who are viewing this thread

Top Bottom