Import Excel - I already searched and still need help

[HD20]

I have used the search and it proved to be very helpful, as always. However, I still have an issue with my coding, it keeps trying to open my Excel file I have imported after I have closed it (or at least I think I have). Here is the code (copied right from another thread with a few tweaks):

Option Explicit

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 Command0_Click()
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
Dim WrksheetName As String
Dim oApp As Object

OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = Form.Hwnd
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 = "Select the Information to Import"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
Exit Sub
End If

Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
oApp.Workbooks.Open OpenFile.lpstrFile

With oApp
.Visible = True
WrksheetName = "Import"
DoCmd.TransferSpreadsheet (acImport), acSpreadsheetTypeExcel9, WrksheetName, OpenFile.lpstrFile, True
End With

oApp.Workbooks.Close
oApp.Quit
Set oApp = Nothing

End Sub

 

[llkhoutx]

Why are you merely using the TransferSpreadsheet action? Why do you event need all that other code? I don't see that you are clearing out the table being filled.

TransferSpreadsheet with a path and file name works great by itself. You don't have top do anything else.

I use the common dialog to set my path and file name.

 

[ghudson]

Remove the red code and just transfer the file, do not try to open it.

Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
oApp.Workbooks.Open OpenFile.lpstrFile

With oApp
.Visible = True
WrksheetName = "Import"

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel97, WrksheetName, OpenFile.lpstrFile, True

End With

oApp.Workbooks.Close
oApp.Quit
Set oApp = Nothing

 

[HD20]

The file path is not constant, I want a dialog box to come up so the user can point it to the Excel file to be imported.

 

[HD20]

Perfect GHudson, thanks!! My other reply was to the first response.

 

[clerics]

And this function will help u to choose what the sheet u want to work with. I think it will help u more.


Function get_seet_name(EXCEL_file As String, EXCEL_seet As String, strCOMB As String)
On Error GoTo get_seet_name_error


Dim db As DAO.Database
Dim tbl As DAO.TableDef
Dim xlFileName As String
Dim xlSeetName As String
Dim nCount As Long



xlFileName = EXCEL_file

Set db = OpenDatabase(xlFileName, True, True, "Excel 8.0;")

nCount = 0

For Each tbl In db.TableDefs

If Right$(tbl.Name, 1) = "$" Or Right$(tbl.Name, 2) = "$'" Then
If Right$(tbl.Name, 1) = "$" Then
xlSeetName = Left$(tbl.Name, Len(tbl.Name) - 1)
Else
xlSeetName = Mid$(tbl.Name, 2, Len(tbl.Name) - 3)
End If

'F![EXCEL_seet_name].AddItem xlSeetName
If nCount >= 1 Then
strCOMB = Trim(strCOMB) & ";" & Trim(xlSeetName)
Else
strCOMB = Trim(xlSeetName)
End If

nCount = nCount + 1
End If
Next tbl

db.Close
Set db = Nothing

Exit Function

get_seet_name_error:

MsgBox "You have a trouble!", 16, "Error message"

Exit Function
End Function

*pm: i want 2 learn more about ACCESS. if i have any problem , please help me friend . Thanks alot !