OK - Make a new Module and Paste this code:
'------------------- Code Start ---------------
Option Compare Database
Option Explicit
'File Handling
Private Const FILE_CURRENT = 1
Private Const FILE_BEGIN = 0
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const OPEN_EXISTING = 3
Private Const FILE_FLAG_RANDOM_ACCESS = &H10000000
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const FILE_ATTRIBUTE_ARCHIVE = &H20
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Const FILE_ATTRIBUTE_HIDDEN = &H2
Private Const FILE_ATTRIBUTE_READONLY = &H1
Private Const FILE_ATTRIBUTE_SYSTEM = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
Private Const CREATE_ALWAYS = 2
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
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_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000 ' force no
long Names for 4.x modules
Private Const OFN_EXPLORER = &H80000 ' new look
commdlg
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000 ' force long
Names for 3.x modules
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Private Const MAXDWORD = &HFFFF
Private Const INVALID_HANDLE_VALUE = -1
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
Declare Function GetFocus Lib "User32" () As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (pOpenfilename As OpenFilename) As Long
Function vbString(ByVal CString As String) As String
On Error Resume Next
Dim Pos As Long
Pos = VBA.InStr(CString, vbNullChar)
If Pos Then
vbString = VBA.Left(CString, Pos - 1)
Else
vbString = CString
End If
End Function
Function CString(Optional ByVal MaxLen As Long = 255) As String
On Error Resume Next
CString = VBA.String(MaxLen, 0)
End Function
Public Function GetFileName(Optional ByVal Title As String = "Locate File",
Optional ByVal Filter As String = "All Files (*.*)|*.*|", Optional ByVal
InitFile As String = VBA.vbNullString) As String
Dim OpenFile As OpenFilename
Dim Res As Long
Dim sFilter As String
Dim Pos As Integer, i As Integer
sFilter = " " & Filter & " "
Pos = VBA.InStr(sFilter, "|")
If Pos = 0 Then
sFilter = " All Files (*.*)|*.*| "
Pos = VBA.InStr(sFilter, "|")
End If
While Pos > 0
sFilter = VBA.Left(sFilter, Pos - 1) & VBA.vbNullChar &
VBA.Mid(sFilter, Pos + 1)
Pos = VBA.InStr(sFilter, "|")
Wend
sFilter = VBA.Trim(sFilter)
With OpenFile
.lStructSize = Len(OpenFile)
.hwndOwner = GetFocus()
.hInstance = 0
.lpstrFile = InitFile & String(257 - VBA.Len(InitFile), 0)
If Len(InitFile) = 0 Then
.lpstrInitialDir = VBA.CurDir()
ElseIf VBA.Len(VBA.Dir(InitFile)) = 0 Then
.lpstrInitialDir = VBA.CurDir()
' ElseIf vba.instr(InitFile, "*") Then
' .lpstrInitialDir = vba.left(InitFile, vba.instr(InitFile, "*") - 1)
' .lpstrFile = vba.Mid(InitFile, vba.instr(InitFile, "*"))
' .lpstrFile = .lpstrFile & String(257 - len(.lpstrFile), 0)
Else
.lpstrInitialDir = VBA.Left(InitFile, VBA.InStr(1, InitFile,
VBA.Dir(InitFile), 1) - 1)
.lpstrFile = VBA.Dir(InitFile) & VBA.String(257 -
VBA.Len(VBA.Dir(InitFile)), 0)
End If
.lpstrFilter = sFilter
.nFilterIndex = 1
.nMaxFile = Len(.lpstrFile) - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = .nMaxFile
.lpstrTitle = Title
.flags = OFN_SHARENOWARN Or OFN_EXPLORER Or OFN_READONLY Or
OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
End With
Res = GetOpenFileName(OpenFile)
If Res <> 0 Then
With OpenFile
GetFileName = vbString(.lpstrFile)
End With
End If
End Function
Function ImportExcel(ByVal TableName As String) As boolean
On Error Resume Next
Dim FileName As String
FileName = GetFileName("Please Select File", "Excel Workbook
(*.xl?)|*.xl?")
If Len(FileName) Then
Access.DoCmd.TransferSpreadsheet acImport, , TableName, FileName
End If
End Function
'------------------- Code End ----------------
modify the macro you're using to:
Action: Runcode
Function Name: ImportExcel("TheTableToImport")
HTH
Pieter
