Discussion :

[capi81]

Bonjour le forum

J'ai une macro (Function) qui devrait me permettre d'ouvrir le dossier contenant les fichiers texte à traiter.
Quand j'appel la macro, rien ne se produit.
Voici la première:

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
Option Explicit
 
'Source : http://www.vbaexpress.com/kb/getarticle.php?kb_id=284
 
Function Browseforfolder(Optional OpenAt As Variant) As Variant
 
     'Function purpose:  To Browser for a user selected folder.
 
     'If the "OpenAt" path is provided, open the browser at that directory
 
     'NOTE:  If invalid, it will open at the Desktop level
 
 
 
    Dim ShellApp As Object
 
    Dim chem As String
 
     'Create a file browser window at the default folder
 
    Set ShellApp = CreateObject("Shell.Application"). _
 
    Browseforfolder(0, "Choisissez le répertoire contenant les fichiers à importer", 0, OpenAt)
 
 
 
     'Set the folder to that selected.  (On error in case cancelled)
 
    On Error Resume Next
 
    chem = "C:\Users\" & Environ("UserName") & "\Desktop\BILAN_DAC_2018\"
 
    Browseforfolder = ShellApp.self.chem
 
    On Error GoTo 0
 
 
 
     'Destroy the Shell Application
 
    Set ShellApp = Nothing
 
 
 
     'Check for invalid or non-entries and send to the Invalid error
 
     'handler if found
 
     'Valid selections can begin L: (where L is a letter) or
 
     '\\ (as in \\servername\sharename.  All others are invalid
 
    Select Case Mid(Browseforfolder, 2, 1)
 
    Case Is = ":"
 
        If Left(Browseforfolder, 1) = ":" Then GoTo Invalid
 
    Case Is = "\"
 
        If Not Left(Browseforfolder, 1) = "\" Then GoTo Invalid
 
    Case Else
 
        GoTo Invalid
 
    End Select
 
 
 
    Exit Function
 
 
 
Invalid:
 
     'If it was determined that the selection was invalid, set to False
 
    Browseforfolder = False
 
 
 
End Function

Voici la macro qui devrait me permettre d'avoir accès au dossier pour exécuter le traitement des fichiers textes.

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
'Importe tous les fichiers textes contenu dans un répertoire sur des feuilles différentes
 
 
Dim chemin As String
 
Dim monFichier As String
 
 
If Sheets("Menu").Range("F1").Value = "" Then
 
    chemin = Browseforfolder()
 
    Sheets("Menu").Range("F1") = chemin
 
Else
 
    chemin = Sheets("Menu").Range("F1").Value
 
 
 
End If
 
 
 
If chemin = "" Then Exit Sub
 
'chemin = "C:\Users\" & Environ("UserName") & "\Desktop\BILAN_DAC_2018\bilan_23032018\"
 
monFichier = Dir(chemin & "*.rep", vbNormal)
 
Do While monFichier <> ""
 
 
'Ouvre un fichier texte en le séparant en 2 colonnes ( cf taille des colonnes)
 
    ActiveWorkbook.Worksheets.Add
 
    With ActiveSheet.QueryTables.Add(Connection:= _
 
        "TEXT;" & chemin & monFichier, Destination:=Range("$A$1"))
 
        .Name = monFichier
 
        .FieldNames = True
 
        .RowNumbers = False
 
        .FillAdjacentFormulas = False
 
        .PreserveFormatting = True
 
        .RefreshOnFileOpen = False
 
        .RefreshStyle = xlInsertDeleteCells
 
        .SavePassword = False
 
        .SaveData = True
 
        .AdjustColumnWidth = True
 
        .RefreshPeriod = 0
 
        .TextFilePromptOnRefresh = False
 
        .TextFilePlatform = 850
 
        .TextFileStartRow = 1
 
        .TextFileParseType = xlFixedWidth
 
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
 
        .TextFileConsecutiveDelimiter = False
 
        .TextFileTabDelimiter = True
 
        .TextFileSemicolonDelimiter = False
 
        .TextFileCommaDelimiter = False
 
        .TextFileSpaceDelimiter = False
 
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
 
        .TextFileFixedColumnWidths = Array(10, 3, 6, 35, 20, 20, 20, 8, 8, 8)
 
        .TextFileDecimalSeparator = "."
 
        .TextFileThousandsSeparator = ","
 
        .TextFileTrailingMinusNumbers = True
 
        .Refresh BackgroundQuery:=False
 
    End With
 
 
 
 
ActiveSheet.Name = Mid(monFichier, 13, 5)
 
ActiveSheet.Range("G1") = Mid(monFichier, 13, 5)
 
monFichier = Dir
 
    Loop
 
End Sub

NB :le dossier contenant les fichiers textes se trouvent sur le bureau et plus précisement dans le dosser BILAN_DAC_2018.
Si j'arrivait à ouvrir ce dossier, j'ai accès maintenant aux sous-dossiers contenant les fichiers texte.
Il ne me suffit plus qu'à choisir le sous-dossier à traiter.

[Menhir]

Commence par supprimer les On Error Goto qui t'empêchent de voir tes erreurs.

Ensuite, pour ouvrir un fichier texte dans Excel, il est plus simple de passer par Workbooks.OpenText que par le Shell.
Et pour choisir le fichier à ouvrir, tu peux utiliser GetOpenFilename.
https://msdn.microsoft.com/fr-fr/VBA...e-method-excel

[Igloobel]

Bonjour,

tu peux aussi lire :

https://warin.developpez.com/access/fichiers/


c'est la gestion des fichiers texte en VBA valable pour ACCESS et EXCEL

moi même je m'en sert en VBA Excel

[Marc-L]

Bonjour,

privilégier les fonctions internes au VBA avant d'utiliser l'ActiveX FileSystemObject (et parfois bien plus lent) …

S'il s'agit d'importer directement dans une feuille de calculs, QueryTables est la bonne option.

___________________________________________________________________________________________________________

Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …