Discussion :

[irouni]

Bonjour,
Je voudrais importer des fichiers .txt commencant par A alors j'ai executer le programme ci-dessous :

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
Sub Macro2()
 
Dim Aryan As String
Dim a
a = "A*.txt"
 
    Aryan = "Appft\MER\1\logAppliVOCAL\oh\" & a & " "
 
    With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;C:\" & Aryan, _
    Destination:=Range("O1"))
 
        .Name = "APPLIVOCAL071211_1"
        .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 = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileOtherDelimiter = "="
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
        1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
 
   End Sub

mais ca ne marche pas
pourriez vous m'aider SVP?

[Singular]

La QueryTable ne peut se connecter qu'à un fichier à la fois. Quand tu lui demandes de se connecter au fichier 'A*.txt' elle ne sait pas quoi faire. Ce caractère (*) ne s'emploit que dans des recherches, pas dans des assignations d'ouverture de fichier.

Pour ouvrir tous les fichiers commençant par 'A', il faut faire une boucle sur tous les noms de fichiers trouvés par le FileSearch.

Ça aurait l'air de ça (je n'ai rien testé car ce serait trop long pour moi de 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
    Dim i As Long
    Const CHEMIN As String = "C:\Appft\MER\1\logAppliVOCAL\oh"
 
    ' Réinitialiser la recherche de fichiers
    With Application.FileSearch
        .NewSearch
        .LookIn = CHEMIN
        .SearchSubFolders = True
        .Filename = "A*.txt"
        .MatchTextExactly = True
        .FileType = msoFileTypeAllFiles
    End With
 
    ' Procéder à la recherche et...
    With Application.FileSearch
 
        If .Execute() > 0 Then
            ' ... si des fichiers correspondants aux critères sont trouvés
            '   faire une itération dans la liste des fichiers trouvés (FoundFiles)
            For i = 1 To .FoundFiles.Count
                With ActiveSheet.QueryTables.Add(Connection:= _
                        "TEXT;" & CHEMIN & Application.PathSeperator & .FoundFiles(i), _
                        Destination:=Range("O1"))
                    .Name = "APPLIVOCAL071211_1"
                    .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 = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierDoubleQuote
                    .TextFileConsecutiveDelimiter = True
                    .TextFileTabDelimiter = True
                    .TextFileSemicolonDelimiter = False
                    .TextFileCommaDelimiter = False
                    .TextFileSpaceDelimiter = True
                    .TextFileOtherDelimiter = "="
                    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, _
                                                        1, 1, 1, 1, 1, 1, 1, 1, _
                                                        1, 1, 1, 1, 1, 1, 1, 1, _
                                                        1, 1, 1)
                    .TextFileTrailingMinusNumbers = True
                    .Refresh BackgroundQuery:=False
                End With
            Next i
        Else
            MsgBox "Aucun fichier correspondant aux critères."
        End If
    End With