Boîte de dialogue d'import de fichier en VBA

Version imprimable

06/03/2012, 18h32
evema

Boîte de dialogue d'import de fichier en VBA

Bonjour,

Je travaille sur Access 2007, et je souhaite rendre plus dynamique mon application. Ce que je cherche à faire c'est :
- Aller chercher un fichier sur mon poste
- Sélectionner l'onglet du fichier en question à importer
- Exécuter l'importation dans une table déjà existante

Est-ce que qqs lignes de code pas trop compliqué permettrait de faire ça ?

Merci beaucoup pour vos réponses !
EM

Bonjour,

Voila un exemple de code pour récupérer un fichier dans une variable sFichier :

Code:

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
Sub TestSelectionFichier()
Dim oFDlg As Object
Dim sFichier As String
 
' Initialisation variable objet oFDlg
Set oFDlg = Application.FileDialog(1)  ' msoFileDialogOpen = 1, msoFileDialogSaveAs = 2
' Titre de la boîte de dialogue
oFDlg.Title = "Sélectionner le fichier"
' Dossier de départ
oFDlg.InitialFileName = CurrentProject.Path
' Sélection multiple = Non
oFDlg.AllowMultiSelect = False
' Filtre
oFDlg.Filters.Clear
oFDlg.Filters.Add "Fichier Excel ou Csv", "*.csv;*.xl*"
 
' Affichage de la boîte de dialogue
sFichier = ""
If oFDlg.Show Then
   sFichier = oFDlg.SelectedItems(1)
End If
' Libération variable objet
Set oFDlg = Nothing
 
' Exploitation résultat
' Soit la variable sFichier est vide (longueur = 0)
' soit elle contient un chemin complet + nom de fichier
If Len(sFichier) = 0 Then
   MsgBox "Aucune sélection", , "Fichier sélectionné"
Else
   MsgBox sFichier, , "Fichier sélectionné"
End If
End Sub

A+

07/03/2012, 16h58
evema

Bonjour,

Merci pour cette réponse.
Je l'ai testé mais ça ne fait pas ce que je souhaite.

Je voudrais ouvrir un fichier excel, sélectionner un onglet particulier, et l'importer dans Access dans une table existante (écraser les données).
Exactement comme la fonction d'import de données externes, mais appliquée à un bouton dans un formulaire.

Je ne sais pas si je suis assez claire... :?

Merci pour votre aide !

Bonsoir,

Mon code ne fait pas plus que ce que j'ai écrit qu'il faisait. Récupérer un nom de fichier.

Comme je ne savais pas qu'il s'agissait de fichiers Excel, je pensais que le terme «onglet» faisait référence à autre chose.

Voila un exemple complet.
Créer un nouveau formulaire.
Ajouter ...

Un bouton et le nommer cmdChoisirFichier.
(Rappel : le nom d'un contrôle est la propriété «Nom» que l'on trouve dans l'onglet «Autres» de la feuille de propriétés)
Une zone texte et la nommer txtFichier
Une zone de liste et la nommer lstOngletsExcel.
Feuille de propriétés, onglet «Données» :
Origine Source : Liste valeurs
Un bouton et le nommer cmdImporterOnglet

Code de l'événement «sur clic» du bouton cmdChoisirFichier:

Code:

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
Private Sub cmdChoisirFichier_Click()
Dim oFDlg As Object, sFichier As String
Dim xldb As DAO.Database, tdf As DAO.TableDef
Dim sListOnglets As String, sOnglet As String
 
On Error GoTo ErrH
 
' Initialisation variable objet oFDlg
Set oFDlg = Application.FileDialog(1)  ' msoFileDialogOpen = 1, msoFileDialogSaveAs = 2
' Titre de la boîte de dialogue
oFDlg.Title = "Sélectionner le fichier"
' Dossier de départ
oFDlg.InitialFileName = CurrentProject.Path
' Sélection multiple = Non
oFDlg.AllowMultiSelect = False
' Filtre
oFDlg.Filters.Clear
oFDlg.Filters.Add "Fichier Excel", "*.xl*"
 
' Affichage de la boîte de dialogue
sFichier = ""
If oFDlg.Show Then
   sFichier = oFDlg.SelectedItems(1)
End If
' Libération variable objet
Set oFDlg = Nothing
 
' Exploitation résultat
' Soit la variable sFichier est vide (longueur = 0)
' soit elle contient un chemin complet + nom de fichier
If Len(sFichier) = 0 Then
   Me.txtFichier = ""
   Me.lstOngletsExcel.RowSource = ""
Else
   Me.txtFichier = sFichier
   ' On ouvre le fichier excel avec DAO
   Set xldb = DAO.DBEngine.OpenDatabase(sFichier, False, True, "Excel 12.0")
   ' On énumère les onglets (=table)
   sListOnglets = ""
   For Each tdf In xldb.TableDefs
       sOnglet = NettoyerNomOnglet(tdf.Name)
       If Len(sOnglet) > 0 Then sListOnglets = sListOnglets & sOnglet & ";"
   Next
   ' On ferme le fichier excel
   xldb.Close
   Set xldb = Nothing
   ' On met à jour la liste des onglets
   If Len(sListOnglets) > 0 Then
      sListOnglets = Left(sListOnglets, Len(sListOnglets) - 1)
      Me.lstOngletsExcel.RowSource = sListOnglets
   Else
     Me.lstOngletsExcel.RowSource = ""
   End If
End If
 
Sortie:
Exit Sub
 
ErrH:
MsgBox "Erreur No. " & Err.Number & " : " & Err.Description
Resume Sortie
 
End Sub

En dessous du code de la sub ci-dessus, coller cette fonction :

Code:

1
2
3
4
5
6
7
8
9
10
11
Function NettoyerNomOnglet(sNom As String) As String
' Retirer guillemets simples
If sNom Like "'*'" Then sNom = Mid(sNom, 2, Len(sNom) - 2)
' Si le nom finit par "$" c'est un onglet, sinon on ignore
If Right(sNom, 1) = "$" Then
   sNom = Left(sNom, Len(sNom) - 1)
Else
   sNom = ""
End If
NettoyerNomOnglet = sNom
End Function

Tant qu'on est dans l'éditeur Visual Basic, vérifier que l'une de ces deux références est cochée :

«Microsoft Office 12.0 Access database engine Object Library»
ou
«Microsoft DAO 3.6 Object Library»

Jusqu'à présent on peut sélectionner un fichier excel et afficher ses onglets dans la zone de liste lstOngletsExcel.
Le nom complet du fichier est mis dans la zone de texte txtFichier.

Voici maintenant le code de l'événement «sur clic» du bouton cmdImporterOnglet :

Code:

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
Private Sub cmdImporterOnglet_Click()
Dim sFichier As String, sOnglet As String
Dim sTableDestination As String
 
' Table dans laquelle on va importer les données
sTableDestination = "test"
 
On Error Resume Next
' On s'assure que la table est fermée
DoCmd.Close acTable, sTableDestination, acSavePrompt
 
' Si on veut détruire la table avant d'importer
'DoCmd.DeleteObject acTable, sTableDestination
 
' Si on veut simplement vider la table avant d'importer
'Application.CurrentDb.Execute "DELETE FROM [" & sTableDestination & "]"
 
On Error GoTo ErrH
 
' Récupérer le nom (complet) du fichier et de l'onglet
sFichier = Nz(Me.txtFichier, "")
sOnglet = Nz(Me.lstOngletsExcel, "")
 
If Len(sFichier) > 0 Then
   If Len(sOnglet) > 0 Then
      sOnglet = sOnglet & "!"
      ' Importer l'onglet
      DoCmd.TransferSpreadsheet acImport, , sTableDestination, sFichier, True, sOnglet
   Else
      ' Importer l'onglet par défaut (le premier du fichier)
      DoCmd.TransferSpreadsheet acImport, , sTableDestination, sFichier, True
   End If
   DoCmd.OpenTable sTableDestination
End If
 
Sortie:
Exit Sub
 
ErrH:
MsgBox "Erreur No. " & Err.Number & " : " & Err.Description
Resume Sortie
End Sub

Ici on met le nom de la table de destination (test dans mon exemple)

Code:

1
2
' Table dans laquelle on va importer les données
sTableDestination = "test"

A+

Bonjour LedZeppII,

ton code à l'air super, et je souhaitais savoir s'il est possible de l'adapter pour mon cas.

J'ai des fichiers Excel (qui ne contiennent qu'un onglet), qui ont tous une structure semblable.
Je souhaiterais pour ma part faire la même chose avec la liste déroulante, mais ne pas écraser dans la même table. Il faudrait que le code créer une nouvelle table dans access pour chaque tableur Excel choisi, et dont je peux choisir le nom.

Penses-tu que c'est possible? Car pour l'instant je fonctionne avec ce code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub importmultiples() Dim i As Integer ChDir "C:\Users\Desktop\Travaux\FormatPivotAnalyse\FormatPivot" monfichier = Dir("*.*") i = 1 On Error Resume Next While monfichier <> "" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "pivot n°" & i, monfichier, True monfichier = Dir() i = i + 1 Wend End Sub
Qui importe tous mes fichiers contenus dans le répertoire, mais le soucis c'est que je ne peux pas choisir le nom (j'aimerais que ce soit une date à la place de pivot numéro i, du genre pivot du 30062013, pivot du 31122013, un truc dans le genre). Mais impossible de modifier quoique ce soit depuis ce code... :(

Si ton code peut-être adapté, il serait parfait pour ce que je veux! :)

Merci d'avance!

07/04/2014, 19h28
LedZeppII

Bonjour,

Est-ce qu'on peut récupérer cette date quelque part ?
Dans le nom du fichier ou dans le nom de l'onglet ?

Sinon je pense qu'il faut remplir une table avec les noms de fichiers Excel et leurs onglets, pour que tu puisse taper le nom de la table à créer.
Cette table serait affichée en tant que sous-formulaire.

Fichier Excel Onglet Nom Table

fichier1.xls Feuil1 04042014

fichier2.xls Feuil1 05042014

fichier3.xls Feuil1 07042014

A+
08/04/2014, 10h07
jslpfasc2

Bonjour LedZeppII, merci pour ta réponse!

Effectivement, les fichiers s'appellent tous "Pivot yyyy-mm-dd" dans le dossier. (Avec yyyy-mm-dd qui varient tu t'en doutes bien!)

Tu penses qu'avec un Format(Right(Application.Excel.Worksheets.Name, 10), "mmddyyyy") (écrit grossièrement) ça pourrait marcher?
Il faut pouvoir utiliser ce genre de fonction Excel dans Access. :(

Bonsoir,

J'espère que la longueur du code ne va pas t'effrayer.
Il est détaillé pour plus de clarté, et pour faciliter la maintenance (c'est l'expérience qui parle).

Code:

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
' ---------------------------------------------------------
' Procédure d'import des fichiers Excel d'un dossier
' ---------------------------------------------------------
Sub ImportFichiersXL()
Dim sDossier As String, sFichier As String
Dim sNomFichierAImporter As String, sDate As String
Dim sNomTableDestination As String
Dim lgFileCnt As Long, lgImportCnt As Long
 
' Dossier contenant les fichiers Excel
sDossier = fnDemanderDossier("C:\Users\Desktop\Travaux\FormatPivotAnalyse\FormatPivot")
If Len(sDossier) = 0 Then
   MsgBox "Aucun dossier n'a été choisi", vbInformation, "Opération annulée"
End If
 
sFichier = Dir(sDossier & "\*.xl*", vbNormal)
Do While Len(sFichier) > 0
   ' Préparer nom table destination
   sDate = fnGetYMDFromFileName(sFichier)
   If Len(sDate) = 8 Then
      sNomTableDestination = "Pivot du " & sDate
   Else
      lgFileCnt = lgFileCnt + 1
      sNomTableDestination = "Pivot (" & Format(Now, "ddmmyyyy") & ") N°" & lgFileCnt
   End If
   ' Supprimer la table si elle existe déjà
   If DCount("*", "MSysObjects", "Name='" & sNomTableDestination & "' And [Type]=1") > 0 Then
      DoCmd.DeleteObject acTable, sNomTableDestination
   End If
 
   ' Préparer nom complet du fichier à importer
   sNomFichierAImporter = sDossier & "\" & sFichier
   ' Importer
   DoCmd.TransferSpreadsheet acImport, , sNomTableDestination, sNomFichierAImporter, True
   lgImportCnt = lgImportCnt + 1
 
   ' fichier suivant
   sFichier = Dir()
Loop
 
MsgBox "Nombre de fichier(s) importé(s): " & lgImportCnt, vbInformation
 
End Sub
 
' ---------------------------------------------------------
' Fonction qui extrait YYYYMMDD d'un nom de fichier
' et retourne DDMMYYYY ou une chaîne vide ("") en
' cas d'echec.
' ---------------------------------------------------------
Function fnGetYMDFromFileName(sFichier As String) As String
Dim sYMD As String, i As Integer, c As String
Dim sValRetour As String
 
' Extraire les 8 1ers chiffres en partant de la gauche
' Ils sont censés représenter l'année, le mois, le jour
For i = 1 To Len(sFichier)
    c = Mid(sFichier, i, 1)
    If c >= "0" And c <= "9" Then
       sYMD = sYMD & c
    End If
    If Len(sYMD) = 8 Then Exit For
Next
If Len(sYMD) = 8 Then
   sValRetour = Mid(sYMD, 7, 2) & Mid(sYMD, 5, 2) & Mid(sYMD, 1, 4)
End If
' Retourner valeur
fnGetYMDFromFileName = sValRetour
End Function
 
' ---------------------------------------------------------
' Fonction pour choisir un dossier
' ---------------------------------------------------------
Function fnDemanderDossier(Optional sInitPath As String = "")
Dim oFDlg As Object, sDossier As String
 
' Initialisation variable objet oFDlg
' 1=Ouvrir Fichier, 2=Enregistrer. sous..., 4=Choisir dossier
Set oFDlg = Application.FileDialog(4)
' Titre de la boîte de dialogue
oFDlg.Title = "Sélectionner le dossier"
' Dossier de départ
If Len(sInitPath) = 0 Then sInitPath = CurrentProject.Path
If Right(sInitPath, 1) <> "\" Then sInitPath = sInitPath & "\"
oFDlg.InitialFileName = sInitPath
' Sélection multiple = Non
oFDlg.AllowMultiSelect = False
' Affichage de la boîte de dialogue
sDossier = ""
If oFDlg.Show Then
   sDossier = oFDlg.SelectedItems(1)
End If
' Libération variable objet
Set oFDlg = Nothing
' Retourner valeur
fnDemanderDossier = sDossier
End Function

Le code est constitué d'une procédure principale qui boucle sur les fichiers Excel du dossier,
et de deux fonctions:

fnGetYMDFromFileName pour extraire YYYYMMDD du nom de fichier et retourner DDMMYYYY
fnDemanderDossier pour choisir le dossier.

Les grosses étapes dans la boucle:

Tente de créer un nom de table «Pivot du DDMMYYY» si fnGetYMDFromFileName n'échoue pas.
Sinon le nom de la table sera «Pivot (DDMMYYYY) N°n» où DDMMYYYY est la date du jour et n un compteur.
Si la table existe déjà on la supprime.
Enfin, on importe le fichier.

A+

09/04/2014, 09h49
jslpfasc2

Waouuu! Génial! Je vais tester ça tout de suite! Merci encore c'est super!
09/04/2014, 10h18
jslpfasc2

Ça fonctionne! Vraiment merci encore. Par contre à quoi sert exactement la fonction "Choisir dossier" à la fin? Car je choisis un dossier, la fonction tourne, mais à la fin il n'y a rien dans le dossier.

En tout cas chapeau pour le code, c'est super cool!

Bonjour,

Citation:

Envoyé par jslpfasc2

... à quoi sert exactement la fonction "Choisir dossier" à la fin? Car je choisis un dossier, la fonction tourne, mais à la fin il n'y a rien dans le dossier.

Cette fonction est appelée au début la procédure principale pour inviter l'utilisateur à sélectionner le dossier dans lequel se trouvent les fichiers Excel.
Le dossier par défaut est celui fourni en argument à la fonction.
Code:

1 2 3 4 5 ' Dossier contenant les fichiers Excel sDossier = fnDemanderDossier("C:\Users\Desktop\Travaux\FormatPivotAnalyse\FormatPivot") If Len(sDossier) = 0 Then MsgBox "Aucun dossier n'a été choisi", vbInformation, "Opération annulée" End If
S'il n'y a pas nécessité de faire intervenir l'utilisateur, remplacer le code ci-dessus par

Code:

sDossier = "C:\Users\Desktop\Travaux\FormatPivotAnalyse\FormatPivot"

La boîte de dialogue "Choisir un dossier" n'affiche que des dossiers. c'est pour cela que l'on ne voit aucun fichier.

A+

Fichier Excel	Onglet	Nom Table
fichier1.xls	Feuil1	04042014
fichier2.xls	Feuil1	05042014
fichier3.xls	Feuil1	07042014