Input a spreadsheet name

  • Thread starter Thread starter Jim Jones
  • Start date Start date
J

Jim Jones

A novice needs some help!

I need some code which will allow my users to input the name of an Excel
spreadsheet. The programme then imports the file into an Access table.

So, I want to use something like

Dim MySpreadsheet As String
MySpreadsheet = InputBox("Input name of spreadsheet")

followed by

DoCmd.TransferSpreadsheet acImport, , "Mytable", "\Mypath\"Myspreadsheet.XLS"

Some code which would work would be very much appreciated.

Jim Jones
 
Hello Jim,

Try this :

Create a new module and copy the code below and run importExcel.

It opens a dialog where you can select a file which wil be imported if
the Excel structure is oké.

grtz

*******************************************************

Type openFileName
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter 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
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type

Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800

Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA"
(pOpenfilename As openFileName) As Long
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA"
(pOpenfilename As openFileName) As Long


Sub importExcel()
Dim fileNaam As String

On Error GoTo Error_importExcel

fileNaam = getFile("Select Excel-file")

If fileNaam = "-1" Then
'Cancel selection
Exit Sub
End If

DoCmd.TransferSpreadsheet acImport, , "Mytable", fileNaam

Exit Sub

Error_importExcel:

MsgBox ("Error " & Err & "(" & Err.Description & ") has occurred in
procedure <importExcel> !"), vbCritical

End Sub

Function getFile(dialogTitle As String) As String
Dim openDialogInfo As openFileName 'Variabele for dialog

On Error GoTo Error_getFile

With openDialogInfo
.lStructSize = Len(openDialogInfo)
.hInstance = 0
.lpstrFilter = "*.xls"
.lpstrCustomFilter = 0
.nMaxCustrFilter = 0
.nFilterIndex = 3
.lpstrFileTitle = Space(256) & vbNullChar
.nMaxFileTitle = Len(.lpstrFileTitle)
.lpstrInitialDir = "c:\"
.lpstrTitle = dialogTitle
.flags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = ""
.lCustrData = 0
.lpfnHook = 0
.lpTemplateName = 0
End With

With openDialogInfo
.lpstrFile = Space(256) & vbNullChar
.nMaxFile = Len(.lpstrFile)
End With

retVal = GetOpenFileName(openDialogInfo)

If retVal <> 0 Then
getFile = Left(openDialogInfo.lpstrFile, InStr(openDialogInfo.lpstrFile,
vbNullChar) - 1)
Else
getFile = -1
End If

Exit Function

Error_getFile:

MsgBox ("Error " & Err & "(" & Err.Description & ") has occurred in function
<getFile> !"), vbCritical

getFile = -1

End Function

******************************************************
 
ceesdatabase gave you a solution that lets your user navigate to the exact
location and get the full path to the file.

If you're satisfied just having them type in the file name, change

DoCmd.TransferSpreadsheet acImport, , "Mytable",
"\Mypath\"Myspreadsheet.XLS"

to

DoCmd.TransferSpreadsheet acImport, , "Mytable", "\Mypath\" &
Myspreadsheet & ".XLS"

or (to provide a little bit of error checking)

If Len(Dir("\Mypath\" & Myspreadsheet & ".XLS")) = 0 Then
MsgBox Myspreadsheet & " does not exist in \Mypath\"
Else
DoCmd.TransferSpreadsheet acImport, , "Mytable", "\Mypath\" &
Myspreadsheet & ".XLS"
End If
 
Douglas

The Ceesdatabase solution was a bit beyond this novice. As you suspect, I
only need the user to input the spreadsheet name and not the path. Your
solution worked first time.

Many thanks indeed - and to ceesdatabase!

Jim Jones
 
Back
Top