Import from Excel but have User Browse for the File

NewbieUK

Registered User.
Local time
Today, 11:03
Joined
Aug 17, 2010
Messages
29
Hi All,

Please can someone help with this:

I have found the following code:

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 i As Integer
Dim oApp As Object
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = Form.hwnd
'OpenFile.hInstance = App.hInstance
sFilter = "acSpreadsheetTypeExcel8 (*.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 = "P:\Bev\Work In\Change Control"
OpenFile.lpstrTitle = "Use the Comdlg API not the OCX"
OpenFile.flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
MsgBox "The User pressed the Cancel Button"
Else
MsgBox "The user Chose " & Trim(OpenFile.lpstrFile)
End If
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), acSpreadsheetTypeExcel97, "Testing Tab", OpenFile.lpstrFile, False, "Access"
Next i
End With
End With
Set oApp = Nothing
End Sub



This I have attached to a button and it works great except for the part where it is importing the data from excel range 3 times!!! Any ideas why.

It is also opening the spreadsheet selected which ideally i dont want it to do. And on top of that when I close the spreadsheet manually, excel then tries to open it again giving the usual 'workbook is now available to open' message and then locks up as I try to press cancel.

I'm a newbie to VBA, so can't spot where it's going wrong. Any help is appreciated as it's driving me crazy!!!

Thanks
 
This is probably because there are three worksheets in the workbook. What are you trying to do exactly?

why the For Loop?
 
I think it is because you are looping through each sheet in the excel spreadsheet

For i = 1 To .Worksheets.Count

But still importing the "Testing Tab"
 
There are 3 worksheets in the book, but the named range is only on one sheet. is there any way around this?

As for the Loop, I dont honestly know, I found this bit of code on another thread and it seems to work ok apart from the duplication.

What I need to do is import 9 cells from excel into an access table. The excel file needs to be defined by the user but will always be in the same format and have the range defined.

Any ideas?

Thanks
 
Are all the cells on the same worksheet in the same place?

Can you post a sample xls with the cells highlighted.
 
Yes the cells are in the same place, from cells A1:I1 on sheet6
 
Then select the range and name it then use the named range for the import
 
Thanks for your help with this David. I have already defined the Range within Excel, it is called Access and I have used this in the transferspreadsheet code, but it is still bringing it in 3 times.

How can I amend the code so that it doesnt Loop and only looks for the named range?

Thanks
 
Code:
With .Workbooks(.Workbooks.Count)
For i = 1 To .Worksheets.Count
WrksheetName = .Worksheets(i).Name
DoCmd.TransferSpreadsheet (acImport), acSpreadsheetTypeExcel97, "Testing Tab", OpenFile.lpstrFile, False, "Access"
Next i
End With

replace with
Code:
DoCmd.TransferSpreadsheet (acImport), acSpreadsheetTypeExcel97, "Testing Tab", OpenFile.lpstrFile, False, "Access"
 
Thank you!! that now works!! Any ideas if I can supress the workbook from opening? As at the moment the workbook opens, then when I close it down, excel notifies me that the workbook is now free for editing and freezes up when I try and say Cancel as to not open it again.

It will be an end user importing the file so ideally I dont want the file to open.

Thanks Again
 
Code:
[B]oApp.Visible = True[/B]
oApp.Workbooks.Open OpenFile.lpstrFile
With oApp
[B].Visible = True[/B]
Remove the bold lines
 
Thank you so much!! that works a treat now!! You are a star!

:):):):):)
 

Users who are viewing this thread

Back
Top Bottom