importation données Excel dans table Access

Bonjour,

as-tu vérifié que ta variable varFichier contenait quelquechose ?
Personellement, quand je veux utiliser une boîte de dialogue sélection de
fichier, j'ai un module avec le code qui suit. Je récupère le nom du fichier
dans une chaîne de caractères grâce à la méthode openFile
Le code qui suit contient cette méthode et deux autres pour sélectionner un
répertoire et sauvegarder un fichier.
En espérant que ça t'aidera

--
Cordialement,

ze_titi


Option Compare Database
Option Explicit

Public Enum Selection
Mono_Sélection = 1
Multi_Sélection = 2
End Enum

Public Const OFN_AllowMultiSelect = &H200
Public Const OFN_CreatePrompt = &H2000
Public Const OFN_EnableHook = &H20
Public Const OFN_EnableTemplate = &H40
Public Const OFN_EnableTemplateHandle = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_ExtensionDifferent = &H400
Public Const OFN_FileMustExist = &H1000
Public Const OFN_HideReadOnly = &H4
Public Const OFN_LongNames = &H200000
Public Const OFN_NoChangeDir = &H8
Public Const OFN_NoDeReferenceLinks = &H100000
Public Const OFN_NoLongNames = &H40000
Public Const OFN_NoNetWorkButton = &H20000
Public Const OFN_NoReadOnlyReturn = &H8000
Public Const OFN_NoTestFileCreate = &H10000
Public Const OFN_NoValiDate = &H100
Public Const OFN_OverWritePrompt = &H2
Public Const OFN_PathMustExist = &H800
Public Const OFN_ReadOnly = &H1
Public Const OFN_ShareAware = &H4000
Public Const OFN_ShareFallThrough = 2
Public Const OFN_ShareNoWarn = 1
Public Const OFN_ShareWarn = 0
Public Const OFN_ShowHelp = &H10
Public Dialogue As OpenFileName
Public strFiltre As String
Public strFile As String
Public strNomFile As String
Public RetVal As Long
Public tOpenFile As Variant
Public nOpenFile As Long
Public Type OpenFileName
lStructSize As Long
hwndOwner As Long
Instance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpInitialFolder 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

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Enum NetWork
WithNetworkFolders = 0
WithoutNetworkFolders = 2
End Enum
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_USENEWUI = &H40


Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As OpenFileName) As Long

Public Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (pOpenfilename As OpenFileName) As Long

Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
On Error GoTo errorHandler
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
strFiltre = _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0)
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile)
End If
Exit Function

errorHandler:
Err.Clear
OpenFile = ""
End Function

Public Function SaveFile(Optional InitialFolder As String = "") As String
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function

Public Function SelectFolder(Optional Folder As String = "" _
, Optional NetWorkFolders As NetWork = WithNetworkFolders _
) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer
If Folder = "" Then Folder = CurrentProject.Path
With bi
.hOwner = hWndAccessApp
.lpszTitle = "Sélectionnez votre dossier et cliquez sur OK"
.ulFlags = BIF_RETURNONLYFSDIRS _
Or BIF_USENEWUI _
Or NetWorkFolders
End With
dwIList = SHBrowseForFolder(bi)
szPath = Folder & Space$(512 - Len(Folder))
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
If X Then
wPos = InStr(szPath, Chr(0))
SelectFolder = Left$(szPath, wPos - 1)
Else
SelectFolder = ""
End If
End Function