Séparer nom de fichier / chemin d'accès / extension d'une variable

**mklHQ** · 25/06/2008, 10h05

Bonjour à tous

Je suis en train de travailler sur une macro excel pour remplir des bons de livraisons automatiquement, je m'explique:

Ma société récupère en ce moment des contrats sur la mise à jour de plans autoCAD. Une fois ces fichiers mis à jour, on les rends format papier (vive la déforestation) et informatique, le tout avec un bon de livraison récapitulant tous les fichiers modifiés.

J'ai donc créé une routine (ou macro, pour parler correctement) qui me permet, en choisissant le répertoire où se trouvent les fichiers, de les lister dans une feuille excel (quand les gars ont passé 5 jours à modifier des cartouches ou autre, ils n'ont pas envie de se faire ch... avec un bon de livraison). Ceci n'étant que la première étape puisque le but est de sortir automatiquement le bon de livraison à partir du répertoire source.

Mais c'est là que le problème survient:

je réussis à avoir la liste des fichiers, mais sous la forme chemin_d'accès\nomdefichier.extension, et je ne voudrait avoir que nomdefichier, je me fous de l'extension et du chemin d'accès.

La question est: Que dois-je modifier à ma macro afin de n'afficher QUE le nom de fichier sans son extension ni son chemin d'accès.
Question subsidiaire pour vous départager: Une fois résupéré le nom de fichier seul, je voudrais le décomposer de cette sorte:
Nom de fichier complet (exemple): 5761M40156300-SP1-41-05-IN-02-00001-016-07
1ère partie = nom de la liasse de plan (x caractères et pas toujours le même nombre) =>> 5761M40156300-SP1-41-05-IN-02-00001
2ème partie = le numéro de folio (toujours 3 caractères qui peuvent être chiffres ou lettres) =>> 016
3ème partie = l'indice de révision (toujours les 2 derniers caractères, chiffres ou lettres) =>> 07

En gros, ma macro m'affiche la liste de fichiers d'un répertoire dans une colonne sous la forme "D:\SP1\U41\5761M40156300-SP1-41-05-IN-02-00001-016-07" et moi, je voudrais l'afficher en 3 colonnes:
colonne 1 = 5761M40156300-SP1-41-05-IN-02-00001
colonne 2 = 016
colonne 3 = 07

Je ne sais pas si les explications sont claires... en tout cas voilà la macro en question:

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
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
 
Function GetFolderName(Msg As String) As String
Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Selectionner un répertoire de travail"
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function
 
 
 
 
 
 
Sub ListeFic()
 
    Dim ScanFic As Office.FileSearch
    Dim NomFic  As Variant
    Dim Diag    As String
    Dim Nbr     As Long
    Dim I       As Long
    Dim chemin As Long
    Set ScanFic = Application.FileSearch
 
    Dim Rep0 As String
Rep0 = GetFolderName("Choisissez un répertoire de travail")
If Rep0 = "" Then Exit Sub
 
 
    With ScanFic
        .NewSearch
        .LookIn = Rep0
        .SearchSubFolders = False
        .Filename = "*.dwg"
        Nbr = .Execute(msoSortByFileName)
        Diag = Format(Nbr, "0 ""fichiers trouvés""")
 
        I = 0
        For Each NomFic In .FoundFiles
            I = I + 1
            Sheets("Feuil1").Cells(I, 1).Value = NomFic
        Next
 
    End With
 
End Sub

D'avance merci

**Godzestla** · 25/06/2008, 10h48

Salut,

essaie ceci (non testé).

Il faudrait gérer le fait que l'instruction Instrrev pourrait ne pas trouver l'argument recherché, alors résultat pos = 0. Je te laisse le faire.

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
 
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
 
Function GetFolderName(Msg As String) As String
Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Selectionner un répertoire de travail"
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function
 
 
 
 
 
 
Sub ListeFic()
 
    Dim ScanFic As Office.FileSearch
    Dim NomFic  As Variant
    Dim Diag    As String
    Dim Nbr     As Long
    Dim I       As Long
    Dim chemin As Long
    Dim Filename_pos As Long
    Dim Dot_pos      As Long
    Dim revision_pos As Long
    Dim folio_pos    As Long
    Dim liasse_pos   As Long
    Set ScanFic = Application.FileSearch
 
    Dim Rep0 As String
Rep0 = GetFolderName("Choisissez un répertoire de travail")
If Rep0 = "" Then Exit Sub
 
 
    With ScanFic
        .NewSearch
        .LookIn = Rep0
        .SearchSubFolders = False
        .Filename = "*.dwg"
        Nbr = .Execute(msoSortByFileName)
        Diag = Format(Nbr, "0 ""fichiers trouvés""")
 
        I = 0
        For Each NomFic In .FoundFiles
            I = I + 1
 
            'Debut Filename = Pos qui suit le dernier \
            Filename_pos = InStrRev(-1, NomFic, "\", vbTextCompare) + 1
            'Séparateur pos
            Dot_pos = InStrRev(-1, NomFic, ".", vbTextCompare)
            'Revision pos
            revision_pos = InStrRev(Dot_pos - 1, NomFic, "-", vbTextCompare) + 1
            'Folio_pos
            folio_pos = InStrRev(revision_pos - 2, NomFic, "-", vbTextCompare) + 1
            'Liasse_pos
            liasse_pos = InStrRev(folio_pos - 2, NomFic, "-", vbTextCompare) + 1
 
 
            Sheets("Feuil1").Cells(I, 1).value = Mid(NomFic, liasse_pos, folio_pos - liasse_pos - 1)
            Sheets("Feuil1").Cells(I, 2).value = Mid(NomFic, folio_pos, revision_pos - folio_pos - 1)
            Sheets("Feuil1").Cells(I, 2).value = Mid(NomFic, revision_pos, dot - pos - revision_pos)
 
        Next
 
    End With
 
End Sub

**mklHQ** · 25/06/2008, 11h19

Salut Godzestla et merci pour ta réponse.

Le problème est que j'avais déjà testé ça et ça me renvoie une erreur car ma variable NomFic est de type variant et non string :s une olution ?

**Godzestla** · 25/06/2008, 11h28

Salut,

et si tu copies nomfic dans une variable String du genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
dim fichier as string
fichier = nomfic

et que tu changes le code que je t'ai donné pour utiliser fichier au lieu de nomfich, normallement ça le fait.

**mklHQ** · 25/06/2008, 11h45

:s

Toujours une incompatibilité de type au niveau des fonctions InStrRev... Je n'arrive pas à comprendre ce qu'il se passe

**Godzestla** · 25/06/2008, 11h50

Et ton code ressemble bien à ceci ?

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
Sub ListeFic()
 
    Dim ScanFic As Office.FileSearch
    Dim NomFic  As Variant
    Dim Diag    As String
    Dim Nbr     As Long
    Dim I       As Long
    Dim chemin As Long
    Dim Filename_pos As Long
    Dim Dot_pos      As Long
    Dim revision_pos As Long
    Dim folio_pos    As Long
    Dim liasse_pos   As Long
    Dim Fichier      As String
    Set ScanFic = Application.FileSearch
    
    Dim Rep0 As String
Rep0 = GetFolderName("Choisissez un répertoire de travail")
If Rep0 = "" Then Exit Sub
 
   
    With ScanFic
        .NewSearch
        .LookIn = Rep0
        .SearchSubFolders = False
        .Filename = "*.dwg"
        Nbr = .Execute(msoSortByFileName)
        Diag = Format(Nbr, "0 ""fichiers trouvés""")
        
        I = 0
        For Each NomFic In .FoundFiles
            I = I + 1
            
            Fichier = NomFic
            'Debut Filename = Pos qui suit le dernier \
            Filename_pos = InStrRev(-1, Fichier, "\", vbTextCompare) + 1
            'Séparateur pos
            Dot_pos = InStrRev(-1, Fichier, ".", vbTextCompare)
            'Revision pos
            revision_pos = InStrRev(Dot_pos - 1, Fichier, "-", vbTextCompare) + 1
            'Revision pos
            folio_pos = InStrRev(revision_pos - 2, Fichier, "-", vbTextCompare) + 1
            'Revision pos
            liasse_pos = InStrRev(folio_pos - 2, Fichier, "-", vbTextCompare) + 1

 
            Sheets("Feuil1").Cells(I, 1).value = Mid(Fichier, liasse_pos, folio_pos - liasse_pos - 1)
            Sheets("Feuil1").Cells(I, 2).value = Mid(Fichier, folio_pos, revision_pos - folio_pos - 1)
            Sheets("Feuil1").Cells(I, 2).value = Mid(Fichier, revision_pos, dot - pos - revision_pos)

        Next
       
    End With
        
End Sub

Ca plante ou ?

Que vaut Fichier (debug.print ?) ?

**mklHQ** · 25/06/2008, 12h00

Oui,

J'ai résolu le problème de l'incompatibilité de type, il y avait une erreur dans la synthaxe (apparemment la synthaxe de InStr est différende de InstrRev):

InstrRev(stringcheck, stringmatch[, start[, compare]])
Ce qui donnerait à priori:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
           'Debut Filename = Pos qui suit le dernier \
            Filename_pos = InStrRev(fichier, "\", -1, vbTextCompare) + 1
            'Séparateur pos
            Dot_pos = InStrRev(fichier, ".", -1, vbTextCompare)
            'Revision pos
            revision_pos = InStrRev(fichier, "-", Dot_pos - 1, vbTextCompare) + 1
            'Folio_pos
            folio_pos = InStrRev(fichier, "-", revision_pos - 2, vbTextCompare) + 1
            'Liasse_pos
            liasse_pos = InStrRev(fichier, "-", folio_pos - 2, vbTextCompare) + 1

Par contre, j'ai un nouveau problème: "argument ou appel de procédure incorrect"

**Godzestla** · 25/06/2008, 12h09

Désolé, je m'étais basé sur la syntaxe de Instr. Autant pour moi.

Par contre, j'ai un nouveau problème: "argument ou appel de procédure incorrect"

Ok mais, il faut préciser où et idéalement donner un debug.print des variables concernées, sinon j'ai un peu de mal à cibler.

**mklHQ** · 25/06/2008, 12h56

Ca y est, j'ai réussi!

en fait, l'erreur d'argument était due aux calculs de l'argument "lengh"

Il y avait une confusion dans les calculs et on se retrouvait avec l'argument qui était négatif, ce qui créait l'erreur.

Voici le code complet

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
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
 
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
 
Function GetFolderName(Msg As String) As String
Dim bInfo As BROWSEINFO, path As String, r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Selectionner un répertoire de travail"
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function
 
 
 
 
 
 
Sub ListeFic()
 Debug.Print
    Dim ScanFic As Office.FileSearch
    Dim NomFic  As Variant
    Dim NomFic1 As String
    Dim Diag    As String
    Dim Nbr     As Long
    Dim I       As Long
    Dim chemin As Long
    Dim Filename_pos As Long
    Dim Dot_pos As Long
    Dim revision_pos As Long
    Dim folio_pos As Long
    Dim liasse_pos As Long
    Dim fichier As String
    Set ScanFic = Application.FileSearch
 
    Dim Rep0 As String
Rep0 = GetFolderName("Choisissez un répertoire de travail")
If Rep0 = "" Then Exit Sub
 
 
    With ScanFic
        .NewSearch
        .LookIn = Rep0
        .SearchSubFolders = False
        .Filename = "*.dwg"
        Nbr = .Execute(msoSortByFileName)
        Diag = Format(Nbr, "0 ""fichiers trouvés""")
 
        I = 0
        For Each NomFic In .FoundFiles
            I = I + 1
 
            fichier = NomFic
            'Debut Filename = Pos qui suit le dernier \
            Filename_pos = InStrRev(fichier, "\", -1, 1) + 1
            'Séparateur pos
            Dot_pos = InStrRev(fichier, ".", -1, 1)
            'Revision pos
            revision_pos = InStrRev(fichier, "-", Dot_pos - 1, 1) + 1
            'Folio_pos
            folio_pos = InStrRev(fichier, "-", revision_pos - 2, 1) + 1
            'Liasse_pos
            liasse_pos = InStrRev(fichier, "-", folio_pos - 2, 1) + 1
 
            Sheets("Feuil1").Cells(I, 1).Value = Mid(fichier, Filename_pos, revision_pos - Filename_pos - 1)
            Sheets("Feuil1").Cells(I, 2).Value = Mid(fichier, folio_pos, revision_pos - folio_pos - 1)
            Sheets("Feuil1").Cells(I, 3).Value = Mid(fichier, revision_pos, Dot_pos - revision_pos)
 
        Next
 
    End With
 
End Sub

Un grand merci à toi Godzestla

Séparer nom de fichier / chemin d'accès / extension d'une variable

Macros et VBA Excel

Discussions similaires

Partager

Partager