Import Excel using a find file dialog box

[atrottier]

I am tring to import an Excel file directly to a table in Access 2003. The code runs but it locks up the app and I need to do a ctrl/alt/del to get out. Here is the code:

Private Declare Function GetOpenFileName Lib "comdlg32.d ll" Alias _
"GetOpenFileNam eA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilt er 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

Private Sub ImportFile_Clic k()
On Error GoTo Err_ImportFile_ Click

Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
Dim WrksheetName As String
Dim i As Integer
Dim oApp As Object

OpenFile.lStruc tSize = Len(OpenFile)
OpenFile.hwndOw ner = Form.Hwnd
'OpenFile.hInst ance = App.hInstance
sFilter = "acSpreadsheetT ypeExcel9 (*.xls)" & Chr(0) & "*.xls" & Chr(0)
OpenFile.lpstrF ilter = sFilter
OpenFile.nFilte rIndex = 1
OpenFile.lpstrF ile = String(257, 0)
OpenFile.nMaxFi le = Len(OpenFile.lp strFile) - 1
OpenFile.lpstrF ileTitle = OpenFile.lpstrF ile
OpenFile.nMaxFi leTitle = OpenFile.nMaxFi le
OpenFile.lpstrI nitialDir = "C:\"
OpenFile.lpstrT itle = "Locate and Select the File for Import"
OpenFile.flags = 0
lReturn = GetOpenFileName (OpenFile)
Set oApp = CreateObject("E xcel.Applicatio n")
oApp.Visible = True
oApp.Workbooks. Open OpenFile.lpstrF ile
With oApp
.Visible = True
With .Workbooks(.Wor kbooks.Count)
For i = 1 To .Worksheets.Cou nt
WrksheetName = .Worksheets(i). Name
DoCmd.TransferS preadsheet acImport, cSpreadsheetTyp eExcel9, _
"AIS Release and Transport Status", OpenFile.lpstrF ile, True
Next i
End With

End With
Set oApp = Nothing

Screen.Previous Control.SetFocu s
DoCmd.FindNext

Exit_ImportFile _Click:
Exit Sub

Err_ImportFile_ Click:
MsgBox Err.Description
Resume Exit_ImportFile _Click

End Sub

I'am stuck as to what to try next. If anyone has an idea I'd sure like to here it. Thanks in advance.

[puppydogbuddy]

I am tring to import an Excel file directly to a table in Access 2003. The code runs but it locks up the app and I need to do a ctrl/alt/del to get out. Here is the code:

Private Declare Function GetOpenFileName Lib "comdlg32.d ll" Alias _
"GetOpenFileNam eA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilt er 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

Private Sub ImportFile_Clic k()
On Error GoTo Err_ImportFile_ Click

Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
Dim WrksheetName As String
Dim i As Integer
Dim oApp As Object

OpenFile.lStruc tSize = Len(OpenFile)
OpenFile.hwndOw ner = Form.Hwnd
'OpenFile.hInst ance = App.hInstance
sFilter = "acSpreadsheetT ypeExcel9 (*.xls)" & Chr(0) & "*.xls" & Chr(0)
OpenFile.lpstrF ilter = sFilter
OpenFile.nFilte rIndex = 1
OpenFile.lpstrF ile = String(257, 0)
OpenFile.nMaxFi le = Len(OpenFile.lp strFile) - 1
OpenFile.lpstrF ileTitle = OpenFile.lpstrF ile
OpenFile.nMaxFi leTitle = OpenFile.nMaxFi le
OpenFile.lpstrI nitialDir = "C:\"
OpenFile.lpstrT itle = "Locate and Select the File for Import"
OpenFile.flags = 0
lReturn = GetOpenFileName (OpenFile)
Set oApp = CreateObject("E xcel.Applicatio n")
oApp.Visible = True
oApp.Workbooks. Open OpenFile.lpstrF ile
With oApp
.Visible = True
With .Workbooks(.Wor kbooks.Count)
For i = 1 To .Worksheets.Cou nt
WrksheetName = .Worksheets(i). Name
DoCmd.TransferS preadsheet acImport, cSpreadsheetTyp eExcel9, _
"AIS Release and Transport Status", OpenFile.lpstrF ile, True
Next i
End With

End With
Set oApp = Nothing

Screen.Previous Control.SetFocu s
DoCmd.FindNext

Exit_ImportFile _Click:
Exit Sub

Err_ImportFile_ Click:
MsgBox Err.Description
Resume Exit_ImportFile _Click

End Sub

I'am stuck as to what to try next. If anyone has an idea I'd sure like to here it. Thanks in advance.

Before trying anything else, take this portion of your code:

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

and move it to a standard module and make it Public. Let me know if that helped

[ADezii]

I am tring to import an Excel file directly to a table in Access 2003. The code runs but it locks up the app and I need to do a ctrl/alt/del to get out. Here is the code:

Private Declare Function GetOpenFileName Lib "comdlg32.d ll" Alias _
"GetOpenFileNam eA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilt er 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

Private Sub ImportFile_Clic k()
On Error GoTo Err_ImportFile_ Click

Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
Dim WrksheetName As String
Dim i As Integer
Dim oApp As Object

OpenFile.lStruc tSize = Len(OpenFile)
OpenFile.hwndOw ner = Form.Hwnd
'OpenFile.hInst ance = App.hInstance
sFilter = "acSpreadsheetT ypeExcel9 (*.xls)" & Chr(0) & "*.xls" & Chr(0)
OpenFile.lpstrF ilter = sFilter
OpenFile.nFilte rIndex = 1
OpenFile.lpstrF ile = String(257, 0)
OpenFile.nMaxFi le = Len(OpenFile.lp strFile) - 1
OpenFile.lpstrF ileTitle = OpenFile.lpstrF ile
OpenFile.nMaxFi leTitle = OpenFile.nMaxFi le
OpenFile.lpstrI nitialDir = "C:\"
OpenFile.lpstrT itle = "Locate and Select the File for Import"
OpenFile.flags = 0
lReturn = GetOpenFileName (OpenFile)
Set oApp = CreateObject("E xcel.Applicatio n")
oApp.Visible = True
oApp.Workbooks. Open OpenFile.lpstrF ile
With oApp
.Visible = True
With .Workbooks(.Wor kbooks.Count)
For i = 1 To .Worksheets.Cou nt
WrksheetName = .Worksheets(i). Name
DoCmd.TransferS preadsheet acImport, cSpreadsheetTyp eExcel9, _
"AIS Release and Transport Status", OpenFile.lpstrF ile, True
Next i
End With

End With
Set oApp = Nothing

Screen.Previous Control.SetFocu s
DoCmd.FindNext

Exit_ImportFile _Click:
Exit Sub

Err_ImportFile_ Click:
MsgBox Err.Description
Resume Exit_ImportFile _Click

End Sub

I'am stuck as to what to try next. If anyone has an idea I'd sure like to here it. Thanks in advance.

There are 3 Major Problems as I see it and puppydogbuddy already cleared up 1 of them. The other 2 are as follows:

1. Typographical Error in TransferSpreads heet line.
   [CODE=vb]DoCmd.TransferS preadsheet acImport, cSpreadsheetTyp eExcel9, _
   "AIS Release and Transport Status", OpenFile.lpstrF ile, True
   ---------------------------- SHOULD READ ----------------------------
   DoCmd.TransferS preadsheet acImport, acSpreadsheetTy peExcel9, _
   "AIS Release and Transport Status", OpenFile.lpstrF ile, True[/CODE]
2. The code is correctly looping through the Worksheets but the same Worksheet will be imported each time with this Method. Modify the Loop as such, and it should work correctly.
   [CODE=vb]
   With oApp
   .Visible = True
   With .Workbooks(.Wor kbooks.Count)
   For i = 1 To .Worksheets.Cou nt
   WrksheetName = .Worksheets(i). Name
   .Worksheets(i). Activate
   'The next 3 lines will obtain the last data cell reference for each Worksheet
   strLastDataColu mn = Chr(Selection.S pecialCells(xlL astCell).Column + 64)
   strLastDataRow = Selection.Speci alCells(xlLastC ell).Row
   strLastDataCell = strLastDataColu mn & strLastDataRow 'e.g. J123
   DoCmd.TransferS preadsheet acImport, acSpreadsheetTy peExcel9, _
   "AIS Release and Transport Status", OpenFile.lpstrF ile, True, .Worksheets(i). Name & "!A1:" & strLastDataCell
   Next i
   End With
   End With
   [/CODE]

[atrottier]

Thanks for the response guys, I got it working now. This site is great for us newbies to Access.