Importing of Excel Files

[Guv1971]

I have two main problems -

(1) I am trying to import Excel files into access - by using the Import function- "The error message I get is "Method Columns of object iimexgrid failed".

If I use the transfer spreadsheet command - I get an error aroudn naming conventions.

(2)What is the simplest way to allow the user to select directory path and filename of these excel files to be imported.

Thanks in advance

Guv

 

[Pigster14]

Hi, Guv.

To answer 1) I have never seen such a message, but when you right click in the Database Window to select import and you browse to the worksheet that you are importing and click ok or import does it give you the import wizard? Or do you get the error message before this? If you get the wizard and go through the options and then click Finish and get the error you may want to change something within the wizard.

2) You asked how the user could specify the location of the spreadsheet. What I have done in the past is on a Form created that the user uses, I put a text box that has a default path in it, but allows the user to change. So maybe the default is C:\Sample.xls. And say when they go to do the import they want to do C:\temp\Sample.xls. The have flexibility if you offer them a location on the form to edit the path and then in your code you can call that text box when you do the import: [Forms]![NameofForm]![NameofTextBox] - this will hold your location and file name or sometimes you can have it just hold the location. Up to you.

Hope this helps, but if you have question, let me know.

Thanks,
Pigster14

 

[mobyduck]

A bit long winded, but I've done it like this is the past.

Create a module called modCommonDialogue to enable you to browse, then use the following type of code in an onclick event

'Call up search box from Module modCommonDialog

GetFileInformation (Find_File(glInitDir))
attachpath = glPath & "\" & glFileName

'Transfer first two rows of Excel format spreadsheet to temp table Results

DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, "results", attachpath, True, "a2:If3"


Code for ModCommonDialoge (just cut and paste it..)

'----Start Code

Option Compare Database
Option Explicit

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Type MSA_OPENFILENAME
strFilter As String
lngFilterIndex As Long
strInitialDir As String
strInitialFile As String
strDialogTitle As String
strDefaultExtension As String
lngFlags As Long
strFullPathReturned As String
strFileNameReturned As String
intFileOffset As Integer
intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

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

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Global glFileName As String
Global glPath As String
Global glInitDir As String


Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer
intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 0 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
strFilter = strFilter & vbNullChar
Else
strFilter = ""
End If
MSA_CreateFilterString = strFilter
End Function

Function MSA_ConvertFilterString(strFilterIn As String) As String
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = ""
intNum = 0
intPos = 1
intLastPos = 1
Do
intPos = InStr(intLastPos, strFilterIn, "|")
If (intPos > intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If
If intNum Mod 2 = 1 Then
strFilter = strFilter & "*.*" & vbNullChar
End If
If strFilter <> "" Then
strFilter = strFilter & vbNullChar
End If
MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
of.flags = of.flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetSaveFileName = intRet
End Function

Function MSA_SimpleGetSaveFileName() As String
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetSaveFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetSaveFileName = strRet
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet
End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub

Private Sub MSAOF_tF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
Dim strFile As String * 512
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 1
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile _
& String(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub

Function Find_File(strSearchPath) As String
Dim msaof As MSA_OPENFILENAME
msaof.strDialogTitle = "Select A File"
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString _
("Excel Files (*.xls", "*.xls;" & _
"All Files (*.*)", "*.*")
MSA_GetOpenFileName msaof
Find_File = Trim(msaof.strFullPathReturned)
End Function
Function Find_Word(strSearchPath) As String
Dim msaof As MSA_OPENFILENAME
msaof.strDialogTitle = "Select A File"
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString _
("Word Files (*.doc", "*.doc;" & _
"All Files (*.*)", "*.*")
MSA_GetOpenFileName msaof
Find_Word = Trim(msaof.strFullPathReturned)
End Function

Public Function GetFileInformation(strPathAndFileName As String)
Dim i As Integer, j As Integer
Dim intCurrPos As Integer
Dim intNextPos As Integer
Dim intFinalPos As Integer
Dim intLength As Integer
intCurrPos = 1
intLength = Len(strPathAndFileName)
For i = 1 To intLength Step intCurrPos
intNextPos = InStr(intCurrPos + 1, strPathAndFileName, "\")
If intNextPos = 0 Then
glFileName = Mid(strPathAndFileName, intCurrPos + 1, intLength)
intFinalPos = intCurrPos
End If
intCurrPos = intNextPos
Next i
glPath = Mid(strPathAndFileName, 1, intFinalPos - 1)
glInitDir = glPath
End Function


'----End code

Hope this helps

MD