Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre actif
    Profil pro
    Inscrit en
    septembre 2007
    Messages
    711
    Détails du profil
    Informations personnelles :
    Âge : 48
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : septembre 2007
    Messages : 711
    Points : 289
    Points
    289

    Par défaut Importation de fichiers même dessin d'enregistrement issus de répertoire différent

    bonjour le phorum

    j'ai créer un macro qui m'importe dans une BDD x fichiers access
    tout se passe bien mais j'aimerai pouvoir gagner du temps, en effet je dois déplacer manuellement tous les fichiers dans une racine commune pour que access m'importe l'intégralité des fichiers
    il s'agit de fichier xl
    j'aimerai étoffer ma macro pour qu'access aille dans des répertoires différents me chercher mes fichiers qui sont toujours nommés pareils sur le début
    client_FDPxxxxx.xls
    voici donc la macro
    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
    Function EXPORT_TABLE()
    'Declaration des variables
    Dim RepertoireBase As String, NomFichier As String
    Dim R001, R002, R003, QueryDef
    
    'Purge Table Principale
    R001 = "DELETE * FROM IMPORTATION_RECAP"
    DoCmd.RunSQL R001
    
    'Récuperation de la liste des fichiers
    RepertoireBase = Application.CurrentProject.Path & "\"
    NomFichier = Dir(RepertoireBase & "*.xls", vbDirectory)
    
    'On passe d'un fichier excel a l'autre
    Do While NomFichier <> ""
    'import des donnees du fichier excel dans Access
          DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel8, "IMPORTATION_RECAP", RepertoireBase & NomFichier, True
          NomFichier = Dir
    Loop
    
    'Création Table pour Insertion Persos Poste
    R002 = "SELECT DESIGNATION, NUMPARUTION INTO DESIGNATION FROM IMPORTATION_RECAP GROUP BY DESIGNATION, NUMPARUTION"
    DoCmd.RunSQL R002
    
    'Insertion Persos Poste
    R003 = "INSERT INTO IMPORTATION_RECAP ( DESIGNATION, NUMPARUTION, ADR2, ADR3, ADR4, ADR5, ADR6, LG1 ) SELECT DESIGNATION.DESIGNATION, DESIGNATION.NUMPARUTION, ""M PERSO"" AS ADR2, ""RUE DE PERSOVILLE"" AS ADR3, ""PERSO"" AS ADR4, ""PERSO"" AS ADR5, ""99999 PERSOVILLE"" AS ADR6, ""9999999"" AS LG1 FROM DESIGNATION   ORDER BY DESIGNATION.DESIGNATION"
    DoCmd.RunSQL R003
    
    'Exportation du Fichier Final
    Set R004 = CurrentDb.CreateQueryDef("R004_EXPORT_TABLE", "Select * From IMPORTATION_RECAP ORDER BY NUMPARUTION, LG1 ")
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "R004_EXPORT_TABLE", Application.CurrentProject.Path & "\EXPORT_TABLE.xls"
    
    
    DoCmd.DeleteObject acTable, "DESIGNATION"
    DoCmd.DeleteObject acQuery, "R004_EXPORT_TABLE"
    
    'Fermeture BDD
    DoCmd.Quit
    
    End Function
    en rouge le code à modifier
    merci pour vos pistes et/ou soluces

    david

  2. #2
    Membre actif
    Profil pro
    Inscrit en
    septembre 2007
    Messages
    711
    Détails du profil
    Informations personnelles :
    Âge : 48
    Localisation : France, Nord (Nord Pas de Calais)

    Informations forums :
    Inscription : septembre 2007
    Messages : 711
    Points : 289
    Points
    289

    Par défaut

    coucou le phorum

    bon en furetant deci dela j'ai trouvé mon bonheur
    je mets le code pour ceux que ca interesse
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
     
    Dim FSO As Object, folder As Object
     
    Set FSO = CreateObject("Scripting.FileSystemObject")
     
    For Each folder In FSO.GetFolder(Application.CurrentProject.Path & "\").SubFolders
    NomFichier = Dir(folder.Path & "\SIMPLES\" & "test*.xls", vbDirectory)
        DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel8, "IMPORTATION_RECAP", folder.Path & "\SIMPLES\" & NomFichier, True '
        Debug.Print NomFichier
    Next
    merci pour ceux qui avaient commencés à chercher

    david

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [AC-2010] Importation données fichier word pour nouvel enregistrement
    Par JordanITDev dans le forum VBA Access
    Réponses: 1
    Dernier message: 07/03/2014, 12h31
  2. Réponses: 22
    Dernier message: 10/07/2011, 17h49
  3. [Débutant] Dessiner des points issus d'un fichier .txt
    Par thtghgh dans le forum MATLAB
    Réponses: 8
    Dernier message: 30/07/2010, 15h01
  4. Réponses: 1
    Dernier message: 27/06/2006, 18h34
  5. Réponses: 2
    Dernier message: 02/02/2006, 18h21

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo