import auto fichier excel

**gui-llaume** · 30/10/2007, 11h01

bonjour,

sur ma base access , j'ai plusieurs tables que je dois remplir régulierement avec des données mises a jour sur feuille excel.

ce que je voudrais parvenir a réaliser, c'est la fonction importer des données externe de access en VBA en cliquant sur un bouton de mon formulaire:
- cibler le fichier
- importer le fichier excel sur une table temp (hormis la premiere ligne)
- remplacer les donnees de la table par celle de la table temp

J'ai plusieurs tables a remplir de cette maniere (donc plusieurs boutons). Faudrais t il faire une fonction pour chacune des tables ou alors une seule fonction avec des arguments spécifique pour chaque table.

J'ai bien cherché sur le forum du code pour faire cela mais j'ai du mal a compiler tous les éléments.

la partie de code pour cibler le fichier :

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
'Fenêtre permettant de choisir un fichier
Public Function OuvrirUnFichier(Handle As Long, _
                                titre As String, _
                                TypeRetour As Byte, _
                                Optional TitreFiltre As String, _
                                Optional typeFichier As String, _
                                Optional RepParDefaut As String) As String
 'OuvrirUnFichier est la fonction a utiliser dans votre formulaire pour ouvrir _
 'la boîte de dialogue de sélection d'un fichier.
 'Explication des paramètres
    'Handle = le handle de la fenêtre (Me.Hwnd)
    'Titre = Titre de la boîte de dialogue
    'TypeRetour (Définit la valeur, de type String, renvoyée par la fonction)
        '1 = Chemin complet + Nom du fichier
        '2 = Nom fichier seulement
    'TitreFiltre = Titre du filtre
        'Exemple: Fichier Excel
        'N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
    'TypeFichier = Extention du fichier (Sans le .)
        'Exemple: XLS
        'N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
    'RepParDefaut = Répertoire d'ouverture par defaut
        'Exemple: C:\windows\system32
        'Si vous laissé l'argument vide, par defaut il se place dans le répertoire de votre application
 
Dim StructFile As OPENFILENAME
Dim sFiltre As String
 
 'Construction du filtre en fonction des arguments spécifiés
If Len(TitreFiltre) > 0 And Len(typeFichier) > 0 Then
  sFiltre = TitreFiltre & " (" & typeFichier & ")" & Chr$(0) & "*." & typeFichier & Chr$(0)
End If
sFiltre = sFiltre & "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)
 
 
 'Configuration de la boîte de dialogue
  With StructFile
    .lStructSize = Len(StructFile) 'Initialisation de la grosseur de la structure
    .hWndOwner = Handle 'Identification du handle de la fenêtre
    .lpstrFilter = sFiltre 'Application du filtre
    .lpstrFile = String$(254, vbNullChar) 'Initialisation du fichier '0' x 254
    .nMaxFile = 254 'Taille maximale du fichier
    .lpstrFileTitle = String$(254, vbNullChar) 'Initialisation du nom du fichier '0' x 254
    .nMaxFileTitle = 254  'Taille maximale du nom du fichier
    .lpstrTitle = titre 'Titre de la boîte de dialogue
    .flags = OFN_HIDEREADONLY  'Option de la boite de dialogue
    If ((IsNull(RepParDefaut)) Or (RepParDefaut = "")) Then
        RepParDefaut = CurrentDb.Name
        PathStripPath (RepParDefaut)
        .lpstrInitialDir = Left(CurrentDb.Name, Len(CurrentDb.Name) - Len(Mid$(RepParDefaut, 1, _
InStr(1, RepParDefaut, vbNullChar) - 1)))
        Else: .lpstrInitialDir = RepParDefaut
    End If
  End With
 
If (GetOpenFileName(StructFile)) Then 'Si un fichier est sélectionné
    Select Case TypeRetour
      Case 1: OuvrirUnFichier = Trim$(Left(StructFile.lpstrFile, InStr(1, StructFile.lpstrFile, vbNullChar) - 1))
      Case 2: OuvrirUnFichier = Trim$(Left(StructFile.lpstrFileTitle, InStr(1, StructFile.lpstrFileTitle, vbNullChar) - 1))
    End Select
Else
    OuvrirUnFichier = ""
End If
 
End Function
 
'Permet de savoir si un fichier est déjà ouvert (pas en mode lecture seule)
Public Function IsFileOpen(sFilePath As String) As Boolean
    Dim nFile As Integer
 
    On Error GoTo Erreur
 
    nFile = FreeFile()
    Open sFilePath For Input Access Read Lock Read Write As nFile
    Close nFile
 
    IsFileOpen = False
    Exit Function
 
Erreur:
    If Err.Number = 70 Then
        ' Si permission refusée, alors fichier déjà ouvert
        IsFileOpen = True
    Else
        ' Sinon, toute autre erreur est répercutée dans la procédure appelante
        Err.Raise Err.Number, "IsFileOpen"
    End If
End Function

le début de ma commande

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
Public Function Intégration()
 
 
 
 
    On Error GoTo Texte_err
    Dim db As Database
    Dim rec As DAO.Recordset, recResult As DAO.Recordset
    Dim fichier As String, SQL As String
    Dim table As String, tablefinal As String, tableBase As String
 
 
    DoCmd.SetWarnings False
    fichier = OuvrirUnFichier(Form_Accueil.Hwnd, "Parcourir", 1, "Fichier import", "xls")
    If fichier = "" Then
        GoTo Nochoice_exit
    End If
    If (IsFileOpen(fichier)) Then
        MsgBox "Le fichier " & fichier & vbLf & "est déjà ouvert. " & vbCrLf & vbCrLf & "Veuillez le fermer avant de recommencer l'import."
        Exit Function
    End If
.....

merci d'avance de me donner un coup de main pour avancer

**gui-llaume** · 30/10/2007, 11h04

par ailleurs , j'ai exploré cette voie pour integrer mon fichier dans une table temporaire, faire des éventuels traitements de cohérence, et ensuite intégrer les données ...

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
' integration des fichiers d'import
 
Public Function Intégration()
    On Error GoTo Texte_err
    Dim table As String, tabletmp As String
    Dim db As Database
    Dim TableSource As DAO.TableDef, TableDestination As DAO.TableDef
    Dim rec As DAO.Recordset, F As DAO.Field, Ftmp As DAO.Field
    Dim dossier As String, fichier As String
 
    'Initialisation des variables et choix du dossier contenant les fichiers à importer
    table = "tmp_import"
    tabletmp = "tmp_importTravailler"
    dossier = SelectFolder("Sélectionnez le répertoire contenant les fichiers EXCEL:", Form_Accueil.Hwnd)
 
    If dossier = "" Then
        GoTo Nochoice_exit
    End If
 
    Set db = CurrentDb
    Set TableSource = db.TableDefs("base")
    effaceTable (tabletmp)
     ' creation de la table de même structure
    Set TableDestination = db.CreateTableDef(tabletmp)
    For Each F In TableSource.Fields
        Set Ftmp = TableDestination.CreateField(F.Name, F.Type, F.Size)
        TableDestination.Fields.Append Ftmp
    Next
    TableDestination.Fields.Refresh
    db.TableDefs.Append TableDestination
    db.TableDefs.Refresh
    Set TableSource = Nothing
    Set TableDestination = Nothing
    db.Close: Set db = Nothing
 
 
    'Import des fichiers dans une table temporaire et traitement de ces données
    fichier = Dir(dossier & "\import*.xls")
    While fichier <> ""
        If (IsFileOpen(dossier & "\" & fichier)) Then
            MsgBox "Le fichier " & fichier & vbLf & "est déjà ouvert. " & vbCrLf & vbCrLf & "Veuillez le fermer avant de recommencer l'import."
            Exit Function
        End If
        fichier = Dir
    Wend
 
    fichier = Dir(dossier & "\import*.xls")
    While fichier <> ""
        effaceTable table
        DoCmd.TransferSpreadsheet acImport, 8, table, dossier & "\" & fichier, False
        fichier = Dir
    Wend
 
    'on transfère les données dans la bonne table
 
    SQL = "INSERT INTO base ( CDCLIENT, TYPECONTRAT, VERSIONCONTRAT, CDCONTRAT, TYPEANNEXE, VERSIONANNEXE, CDANNEXE, TYPESERVICE, CDSERVICE, PU, QTE )" & _
            "SELECT CDCLIENT, TYPECONTRAT, VERSIONCONTRAT, CDCONTRAT, TYPEANNEXE, VERSIONANNEXE, CDANNEXE, TYPESERVICE, CDSERVICE, PU, QTE" & _
            " FROM tmp_importTravailler;"
 
    '''je pense qu'ici il faudrait qqchose mais quoi ????
 
    DoCmd.SetWarnings False
    DoCmd.RunSQL SQL
    DoCmd.SetWarnings True
   ' DoCmd.DeleteObject acTable, tabletmp
   ' DoCmd.DeleteObject acTable, table
 
    'Message de réussite
    MsgBox "L'import des fichiers EXCEL a été un succès.", , "Succès de l'import"
 
Nochoice_exit:
    Exit Function
Texte_err:
   MsgBox "Erreur " & Err.Number & " : " & Err.Description
 
End Function

**gui-llaume** · 30/10/2007, 11h05

mais cette derniere portion de code est un piteux essai non transformé.

tout ca pour vous montrer que j'ai cherché mais que je coince ...

**gui-llaume** · 30/10/2007, 11h39

pour résumer car je crois que je n'ai pas du tout été clair sur un sujet qui doit etre simple pourtant :

j'ai les parties de codes pour cibler le fichier.
il me manque la partie pour créer une table temp et l'insérer dans la table ...

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
Public Sub Intégration_tb_client()
 
 
    On Error GoTo Texte_err
    Dim db As Database
    Dim rec As DAO.Recordset, recResult As DAO.Recordset
    Dim fichier As String, SQL As String
    Dim table As String, tablefinal As String
 
 
    DoCmd.SetWarnings False
    fichier = OuvrirUnFichier(Form_Accueil.Hwnd, "Parcourir", 1, "Fichier import", "xls")
    If fichier = "" Then
        GoTo Nochoice_exit
    End If
    If (IsFileOpen(fichier)) Then
        MsgBox "Le fichier " & fichier & vbLf & "est déjà ouvert. " & vbCrLf & vbCrLf & "Veuillez le fermer avant de recommencer l'import."
        Exit Sub
    End If
 
' ****ici la partie de code que je n'arrive pas a faire !!
' ****c'est a dire , importer le fichier excel dans une table temporaire temp_client , 
' ****puis l'injecter dans ma table par la requete sql  (sauf que je voudrais vider la table client d'abord ou en tout cas remplacer tous les enregistrements par des nouveaux : 
 
INSERT INTO client ( cdclient, cip, ACTIF, rs, civil, nom, adr1, adr2, adr3, cp, ville, cduga, cdgrp, tournee, siret, tvacee, [CODE ACTEUR], dateintegrationclient )
SELECT tmp_client.CDCLIENT, tmp_client.CIP, tmp_client.[ACTIF], tmp_client.RS, tmp_client.CIVIL, tmp_client.NOM, tmp_client.ADR1, tmp_client.ADR2, tmp_client.ADR3, tmp_client.CP, tmp_client.VILLE, tmp_client.CDUGA, tmp_client.CDGRP, tmp_client.TOURNEE, tmp_client.SIRET, tmp_client.TVACEE, tmp_client.[CODE ACTEUR], Date() AS Expr3
FROM tmp_client;
 
 
   DoCmd.TransferSpreadsheet transfertype:=acImport, _
            TableName:="tmpTableclient", _
            Hasfieldnames:=True ', _
            'Range:="'WorkSheet Name!'" ', _
          ' spreadsheertype:=5

**DMboup** · 30/10/2007, 11h59

Envoyé par gui-llaume

' ****ici la partie de code que je n'arrive pas a faire !!
' ****c'est a dire , importer le fichier excel dans une table temporaire temp_client ,
' ****puis l'injecter dans ma table par la requete sql (sauf que je voudrais vider la table client d'abord ou en tout cas remplacer tous les enregistrements par des nouveaux :

Après avoir choisi le fichier excel à traiter, au lieu de l'ouvrir tu as deux possibilités

1. Soit importer les données dans une table temporaire.
Pour ce cas de figure, les champs seront du type champ1, champ2, ...
pour remplir ta table de destination, il faudra nécessairement pour faire la correspondance de ces champs d'avec les champs de la table de destination.

Une fois cette correspondance faite, il ne te resteras que faire une requête ajout tout simplement.

2. Soit utiliser automation pour piloter Excel depuis Access.
Pour ce cas regarde dans la FAQ.

**gui-llaume** · 30/10/2007, 12h23

merci pour ta réponse DMboup.

je pense que j'y suis presque mais y a juste un probleme erreur 424 objet requis sur mes docmd. probablement un pb dans mes definitions ...

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
Public Sub Intégration_tb_client()
 
 
    On Error GoTo Texte_err
    Dim db As DAO.Database
    Dim fichier As String
 
 
 
    DoCmd.SetWarnings False
    fichier = OuvrirUnFichier(Form_Accueil.Hwnd, "Parcourir", 1, "Fichier import", "xls")
    If fichier = "" Then
        GoTo Nochoice_exit
    End If
    If (IsFileOpen(fichier)) Then
        MsgBox "Le fichier " & fichier & vbLf & "est déjà ouvert. " & vbCrLf & vbCrLf & "Veuillez le fermer avant de recommencer l'import."
        Exit Sub
    End If
 
        'efface la table client
        effaceTable client
 
        DoCmd.TransferSpreadsheet _
        TransferType:=acImport, _
        spreadsheettype:=5, _
        tablename:="tmp_client", _
        Filename:=fichier, _
        HasFieldNames:=True
 
 
 
 
 
    Cmd.SetWarnings False
 
    DoCmd.RunSQL ("INSERT INTO client (cdclient, cip, ACTIF, rs, civil, nom, adr1, adr2, adr3," & _
        "cp, ville, cduga, cdgrp, tournee, siret, tvacee, code acteur, dateintegrationclient )" & _
        "SELECT CDCLIENT, IP, actif, RS, CIVIL, NOM, ADR1, ADR2, ADR3, CP, VILLE, CDUGA," & _
        "CDGRP, TOURNEE, SIRET, TVACEE, code acteur, Date() " & _
        "FROM tmp_client;")
 
    DoCmd.SetWarnings True
 
    'efface table temporaire
    DoCmd.DeleteObject acTable, tmp_client
 
    'Message de réussite
    MsgBox "L'import des fichiers EXCEL a été un succès.", , "Succès de l'import"
 
 
Nochoice_exit:
    Form_Attente.Fermer
    Exit Sub
Texte_err:
    MsgBox "Erreur " & Err.Number & " : " & Err.Description
    Resume Nochoice_exit
 
End Sub

qu'en penses tu ?

import auto fichier excel

VBA Access

Vue hybride

Discussions similaires

Partager

Partager