By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,510 Members | 1,497 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,510 IT Pros & Developers. It's quick & easy.

Import Excel using a find file dialog box

P: 17
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.
Jul 17 '07 #1
Share this Question
Share on Google+
3 Replies


puppydogbuddy
Expert 100+
P: 1,923
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:
Expand|Select|Wrap|Line Numbers
  1. Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
  2. "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
  3.  
and move it to a standard module and make it Public. Let me know if that helped
Jul 17 '07 #2

ADezii
Expert 5K+
P: 8,602
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.
    Expand|Select|Wrap|Line Numbers
    1. DoCmd.TransferSpreadsheet acImport, cSpreadsheetTypeExcel9, _
    2. "AIS Release and Transport Status", OpenFile.lpstrFile, True
    3. ---------------------------- SHOULD READ ----------------------------
    4. DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    5. "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.
    Expand|Select|Wrap|Line Numbers
    1. With oApp
    2.   .Visible = True
    3.       With .Workbooks(.Workbooks.Count)
    4.           For i = 1 To .Worksheets.Count
    5.              WrksheetName = .Worksheets(i).Name
    6.              .Worksheets(i).Activate
    7.              'The next 3 lines will obtain the last data cell reference for each Worksheet
    8.                  strLastDataColumn = Chr(Selection.SpecialCells(xlLastCell).Column + 64)
    9.                  strLastDataRow = Selection.SpecialCells(xlLastCell).Row
    10.                  strLastDataCell = strLastDataColumn & strLastDataRow    'e.g. J123
    11.                  DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    12. "AIS Release and Transport Status", OpenFile.lpstrFile, True, .Worksheets(i).Name & "!A1:" & strLastDataCell
    13.           Next i
    14.       End With
    15. End With
    16.  
Jul 17 '07 #3

P: 17
Thanks for the response guys, I got it working now. This site is great for us newbies to Access.
Jul 18 '07 #4

Post your reply

Sign in to post your reply or Sign up for a free account.