[AC-2003] Import Excel vers Access avec choix du répertoire et du fichier *.xls [Résolu]

[jeanpierre78]

Bonjour,

Pour permettre à plusieurs sections d'une association sportive d'harmoniser et de simplifier la comptabilité, je développe une application sous Access. J'ai réalisé la BD de comptabilité pour les sections. Cette BD me permet d'exporter la balance comptable d'une année au format Excel.

Dans la BD de l'association mère qui ne sera pas sur les mêmes ordinateurs, je dois importer les tableaux Access de chaque section. Si le chemin d'accés est toujours le même pas de difficulté, je sais le faire avec des macros. Mais je souhaite, dans le code à placer sur un bouton, donner le choix du répertoire et du fichier *.xls à importer.

Comment faire.

Merci.

Jean-Pierre

[Triton972]

Bonsoir Jean-Pierre,

Je pense que tu pourrais utiliser élégamment la propriété "FileDialog" de l'objet " Application". Le mode d'emploi est dans l'aide (F1), il te donnera tous les détails.
Cordialement,

[jeanpierre78]

Bonjour,

Merci pour ta réponse.

1. Filedialog : Lorsque je place l'exemple de MS Office sur un bouton pour essayer, j'ai le message d'erreur : "Erreur de compilation- Type défini par l'utilisateur non défini." sur la première ligne.

2. Afficher la boîte de dialogue ouvrir afin de récupérer le nom et le chemin du fichier sélectionné (du FAQ Access http://access.developpez.com/faq/?pa...#AffBoitDialog) :
- je place le code dans un module OuvrirUnFichier
- je place le code

Code :

        MsgBox OuvrirUnFichier(Application.hwndAccessApp, "Parcourir", 1, "Fichier Excel", "xls")

sur un bouton dans mon formulaire. J'ai alors le message d'erreur suivant : "Erreur de compilation. Variable ou procédure attendue, et non un module."!!

Mon but est de récupérer le chemin et le nom du fichier Excel à importer.

Jean-Pierre

[Triton972]

Bonsoir Jean-Pierre,

J'utilise ce code pour sélectionner un fichier ou un répertoire en utilisant le navigateur Windows.
stTitre est le titre de la boîte
stType est le type de recherche : ("F" pour un fichier, "R" pour un répertoire)
La fonction renvoie le fichier (ou le répertoire) sélectionné.

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
 
Function Selection(stTitre As String, stType As String) As String
Dim fd As Office.FileDialog
Dim varRep As Variant
 
    If stType <> "F" And stType <> "R" Then
        Selection = ""
        MsgBox "Erreur dans le passage des paramètres"
        Exit Function
    End If
 
    If stType = "F" Then
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Else
        Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    End If
    With fd
        .Title = stTitre
        .InitialFileName = ""
        .AllowMultiSelect = False
    End With
 
    If fd.Show = False Then
        Set fd = Nothing
        Selection = ""
        Exit Function
    End If
    For Each varRep In fd.SelectedItems
        MsgBox "Votre sélection : " & fd.SelectedItems(1)
    Next
Selection = fd.SelectedItems(1)
Set fd = Nothing
 
End Function

Est-ce cela pourrait t'aider ?
Cordialement,

[rob1son76]

Fait un bouton parcourir.
Regarde les poste que j'ai ouvert l'un des derniers est justement sur le bouton parcourir.

[jeanpierre78]

Bonjour et merci pour vos réponses.

1. Réponse de rob1son76
Selon le post http://www.developpez.net/forums/d11...ut-modifiable/, j'ai :
- créé le module OuvrirUnFichier
- placé le code suivant sur un bouton.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Commande214_Click()
 
    Dim strFullFilename  As String
    Dim strFilename      As String
    Dim strPathname      As String
 
    strFullFilename = OuvrirUnFichier(Application.hwndAccessApp, "Parcourir", 1, "Fichier Excel", "xls")
    strFilename = Mid$(strFullFilename, InStrRev(strFullFilename, "\") + 1)
    strPathname = Left$(strFullFilename, InStrRev(strFullFilename, "\") - 1)
 
    MsgBox strPathname & "\" & strFilename
 
End Sub

2. Réponse de Triton972
J'ai créé le module selection, placé le code suivant sur un bouton :

Code :

1
2
3
4
5
6
7
8
9
Private Sub Commande215_Click()
 
    Selection("Chemin", "R") = strFilePath
    Selection("Fichier", "F") = strFilename
 
    strChoixImp = strFilePath & "\" & strFilename
    MsgBox strChoixImp
 
End Sub

Dans les deux versions, lors de l'exécution, j'ai le message d'erreur
"Erreur de compilation Variable ou procédure attendue, et non un module."
sur la ligne OuvrirUnFichier.

Où est mon erreur?

Jean-Pierre

[rob1son76]

Tu as bien mis se code dans un module:

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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
Option Compare Database
 
'Déclaration de l'API
Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
                   "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
 
 'Structure du fichier
Private Type OPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
 
 'Constantes
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
 
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
 
 
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
    '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 Access
        'N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
    'TypeFichier = Extention du fichier (Sans le .)
        'Exemple: MDB
        '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
  End If
 
End Function

et ce code sur ton formulaire dans l'évènement sur clic de ton bouton:

Code :

1
2
3
4
5
6
7
8
9
10
Dim strFullFilename  As String
Dim strFilename      As String
Dim strPathname      As String
 
    strFullFilename = OuvrirUnFichier(Application.hWndAccessApp, "Parcourir", 1, "Fichier Excel", "xlsx")
    strFilename = Mid$(strFullFilename, InStrRev(strFullFilename, "\") + 1)
    strPathname = Left$(strFullFilename, InStrRev(strFullFilename, "\") - 1)
    'strFilename est le nom du fichier
    'strPathname  est le chemin d'accès qui se trouve avant le nom
    'si tu veux le chemin complet tu met: strPathname & "/" & strFilename

Si oui ca viens peut être de tes références.

[rob1son76]

Attention j'ai mis par défaut le type xlsx comme fichier (excel 2007 sans macro)
N'oublie pas de le changer en xls si tu veux des fichiers excel.

regarde le tuto sur lequel j'ai fait mon code.
http://access.developpez.com/faq/?pa...#AffBoitDialog

[jeanpierre78]

Bonsoir,

J'ai bien copié le bon code dans le module OuvrirUnFichier et sur le bouton du formulaier, évennement Sur Clic et j'ai toujours le même message d'erreur!!

Que j'utilise le code du tuto ou le tien, le résultat est le même.

Jean-Pierre

[nico84]

Bonsoir,

J'utilise une méthode proche de celle de Robinson...

Dans un module de classe, déclaration :

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
'Pour chercher un fichier dans l'explorateur
'source http://www.lesite.com/reponses/microsoft-common-dialog-control-entraide-1032091.html#reponse
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
 
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Dans un formulaire, il faut un champ "fichier" et un bouton "parcourir" :

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
'Pour chercher un fichier dans l'explorateur
Private Sub Parcourir_Click()
If Not Mode_debug Then On Error GoTo err:
Dim OFName As OPENFILENAME
Dim a As Integer
100 Me.fichier.SetFocus
102 OFName.lStructSize = Len(OFName) 'Set the structure size
104 OFName.hwndOwner = Me.hwnd       'Set the owner window
106 OFName.hInstance = Application.hWndAccessApp 'Set the application's instance
    'Set the filet
108 OFName.lpstrFilter = "excel (*.xls*)" + Chr$(0) + "*.xls*" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0)
110 OFName.lpstrFile = Space$(254) 'Create a buffer
112 OFName.nMaxFile = 255          'Set the maximum number of chars
114 OFName.lpstrFileTitle = Space$(254) 'Create a buffer
116 OFName.nMaxFileTitle = 255 'Set the maximum number of chars
118 OFName.lpstrInitialDir = Application.CurrentProject.path 'Set the initial directory
120 OFName.lpstrTitle = "Choix du fichier source" 'Set the dialog title
122 OFName.flags = 0 'no extra flags
    'Show the 'Open File'-dialog
124 If GetOpenFileName(OFName) Then
      'on recupere 254 caracteres il faut limiter au fichier et trouver chr(0)
126   a = InStr(OFName.lpstrFile, Chr(0))
128   fichier = Left(OFName.lpstrFile, a - 1)
130   Me.Refresh
    End If
    Exit Sub
err: Call message("Erreur " & err.Number & "/" & Erl & " dans stock_imp.parcourir : " & err.description)
End Sub

Il faut peut-être ajouter une référence pour que ça marche, regarde dans le lien indiqué en commentaire

[jeanpierre78]

Bonjour,

Toutes vos solutions me conduisent à la même erreur.

Jean-Pierre

[Domi2]

Bonjour,

La fonction de la FAQ fonctionne parfaitement.

Mais à te lire, tu l'as mise dans un module appelé OuvrirUnFichier.

Si ton module se nomme la même chose que la fonction, cela va de toute façon provoquer une erreur.

Renomme déjà ton module, par exemple : basOuvrirUnFichier.

Et redis-nous.

Domi2

[jeanpierre78]

Bonjour,

Bravo et merci Domi2, mon problème était bien là. J'avais commis l'erreur de donner le même nom au module qu'à la fonction.
Mon problème est résolu.

Jean-Pierre