Discussion :

[grostathar]

bonjour

Dans la boucle qui suit j importe toutes les tables d'un repertoire
le probleme est qu a la fin il cherche un fichier vide
(au lieu de chercher à importer un "C:\AAAA\AA\342.mdb" il cherche le fichier "C:\AAAA\AA\") Comment faire pour qu apres le dernier fichier il passe a la macro U21CCCC?

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
Sub U21()
 
    Windows("001Macro.xlsm").Activate
    ActiveWorkbook.Save
'ImportVal00
    Workbooks.Open Filename:="C:\AAAA\000TotalFiltre.xlsx"
 
Dim Chemin As String, Fichier As String
 
    Chemin = "C:\AAAA\AA\" 'Définit le répertoire contenant les fichiers
 
    Fichier = Dir(Chemin & "*.*") 'Boucle sur tous les fichiers xls du répertoire.
'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:
Do While Len(Fichier) > 0 'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
 Debug.Print Chemin & Fichier
        Fichier = Dir()
'ouverture Base2
    Workbooks.Open Filename:="C:\AAAA\000Base.xlsx"
    Windows("000Base.xlsx").Activate
    Sheets("Feuil1").Select
    Range("C1").Select
'Import Fichier de C:\AAAA\ImportU21\
       With ActiveSheet.ListObjects.Add(SourceType:=0 _
            , Source:=Array("OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & Chemin & Fichier & ";Mode=Share Deny Write;E" _
            , "xtended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Ty" _
            , "pe=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Da" _
            , "tabase Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compac" _
            , "t=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False") _
            , Destination:=Range("$C$1")).QueryTable
           .CommandType = xlCmdTable
           .CommandText = Array("urgence")
           .RowNumbers = False
            .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = Station
        .ListObject.DisplayName = "Tableau_Val__1"
        .Refresh BackgroundQuery:=False
    End With
    Application.Run "001Macro.xlsm!U21BBBB"
    Loop
 
'Fin Boucle for next pour import Mdb et execute macro BBBB
   Application.Run "001Macro.xlsm!U21CCCC"
End Sub

Encore Merci a vous et bonne soiree

La reponse doit etre toute conne donc cest la question qui est mal posé
En faite ma boucle marche tres bien juste à la fin au lieu de passé a la suite de ma macro il me cherche un fichier sans nom de fichier

Merci a vous pour votre aide et pour se fofo indispensable pour les noobs comme moi

[grostathar]

j ai trouver une autre solution je passe par un boucle for next ^^
des fois que je laisse le code

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
Dim Dossier As Object, fso As Object
Dim Files As Object
Dim MaVal
Sub U21NEXTFOR()
 
    Windows("001Macro.xlsm").Activate
    ActiveWorkbook.Save
'ImportVal00
    Workbooks.Open Filename:="C:\AAAA\000TotalFiltre.xlsx"
'Boucle
 
  ' Création de l'objet File System Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  ' Créé l'objet Dossier à partir du chemin definit
  Set Dossier = fso.GetFolder("C:\AAAA\AA")
  Set Files = Dossier.Files
  ' Si aucun fichier dans le dossier, on sort de la procédure
  If Files.Count = 0 Then Exit Sub
  ' Sinon pour chaque fichier
  For Each File In Files
    ' Contruit le chemin d'accès
    VPath = Dossier.Path & "\" & File.Name
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'ouverture Base
    Workbooks.Open Filename:="C:\AAAA\000Base.xlsx"
    Windows("000Base.xlsx").Activate
    Sheets("Feuil1").Select
    Range("C1").Select
'Import Fichier de C:\AAAA\ImportU21\
       With ActiveSheet.ListObjects.Add(SourceType:=0 _
            , Source:=Array("OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & File & ";Mode=Share Deny Write;E" _
            , "xtended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Ty" _
            , "pe=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Da" _
            , "tabase Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compac" _
            , "t=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False") _
            , Destination:=Range("$C$1")).QueryTable
           .CommandType = xlCmdTable
           .CommandText = Array("urgence")
           .RowNumbers = False
            .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceDataFile = Station
        .ListObject.DisplayName = "Tableau_Val__1"
        .Refresh BackgroundQuery:=False
    End With
   Set MaVal = File
    Application.Run "001Macro.xlsm!U21BBBB"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Next
 
   Application.Run "001Macro.xlsm!U21CCCC"
End Sub