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.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

Private Sub ImportFile_Click()
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.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = Form.Hwnd
'OpenFile.hInstance = App.hInstance
sFilter = "acSpreadsheetTypeExcel9 (*.xls)" & Chr(0) & "*.xls" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = "Locate and Select the File for Import"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
oApp.Workbooks.Open OpenFile.lpstrFile
With oApp
.Visible = True
With .Workbooks(.Workbooks.Count)
For i = 1 To .Worksheets.Count
WrksheetName = .Worksheets(i).Name
DoCmd.TransferSpreadsheet acImport, cSpreadsheetTypeExcel9, _
"AIS Release and Transport Status", OpenFile.lpstrFile, True
Next i
End With

End With
Set oApp = Nothing

Screen.PreviousControl.SetFocus
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.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

Private Sub ImportFile_Click()
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.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = Form.Hwnd
'OpenFile.hInstance = App.hInstance
sFilter = "acSpreadsheetTypeExcel9 (*.xls)" & Chr(0) & "*.xls" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = "Locate and Select the File for Import"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
oApp.Workbooks.Open OpenFile.lpstrFile
With oApp
.Visible = True
With .Workbooks(.Workbooks.Count)
For i = 1 To .Worksheets.Count
WrksheetName = .Worksheets(i).Name
DoCmd.TransferSpreadsheet acImport, cSpreadsheetTypeExcel9, _
"AIS Release and Transport Status", OpenFile.lpstrFile, True
Next i
End With

End With
Set oApp = Nothing

Screen.PreviousControl.SetFocus
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.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

Private Sub ImportFile_Click()
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.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = Form.Hwnd
'OpenFile.hInstance = App.hInstance
sFilter = "acSpreadsheetTypeExcel9 (*.xls)" & Chr(0) & "*.xls" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\"
OpenFile.lpstrTitle = "Locate and Select the File for Import"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
oApp.Workbooks.Open OpenFile.lpstrFile
With oApp
.Visible = True
With .Workbooks(.Workbooks.Count)
For i = 1 To .Worksheets.Count
WrksheetName = .Worksheets(i).Name
DoCmd.TransferSpreadsheet acImport, cSpreadsheetTypeExcel9, _
"AIS Release and Transport Status", OpenFile.lpstrFile, True
Next i
End With

End With
Set oApp = Nothing

Screen.PreviousControl.SetFocus
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 TransferSpreadsheet line.
   

   DoCmd.TransferSpreadsheet acImport, cSpreadsheetTypeExcel9, _
   "AIS Release and Transport Status", OpenFile.lpstrFile, True
   ---------------------------- SHOULD READ ----------------------------
   DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
   "AIS Release and Transport Status", OpenFile.lpstrFile, True

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.
   

   With oApp
     .Visible = True
         With .Workbooks(.Workbooks.Count)
             For i = 1 To .Worksheets.Count
                WrksheetName = .Worksheets(i).Name
                .Worksheets(i).Activate
                'The next 3 lines will obtain the last data cell reference for each Worksheet
                    strLastDataColumn = Chr(Selection.SpecialCells(xlLastCell).Column + 64)
                    strLastDataRow = Selection.SpecialCells(xlLastCell).Row
                    strLastDataCell = strLastDataColumn & strLastDataRow    'e.g. J123
                    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
   "AIS Release and Transport Status", OpenFile.lpstrFile, True, .Worksheets(i).Name & "!A1:" & strLastDataCell
             Next i
         End With
   End With
    

[atrottier]

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