VBA code not importing excel data as intended to

[CoolFactor]

The goal is to import excel data from the various columns in the worksheet knowingly that the first row is generally the column names in the worksheet. I created a table in Access with the columns that should match up with excel column names.

This is the part of the code that I'm having issues with and after this is the whole code:

rst("PEODirectorate") = ExcApp.Worksheets("Sheet1").Range("A2").Value
rst("Profile") = ExcApp.Worksheets("Sheet1").Range("B2").Value
rst("System") = ExcApp.Worksheets("Sheet1").Range("C2").Value
rst("Hull") = ExcApp.Worksheets("Sheet1").Range("D2").Value
rst("HullNumber") = ExcApp.Worksheets("Sheet1").Range("E2").Value


The Whole Code:

Option Compare Database

Private Sub cmdStar_Click()
On Error GoTo Err_cmdStar_Click
Dim NewRow As Integer
Dim R() As String
Dim InFile As String
Dim fileToOpen As String
Dim db As Database
Dim rst As Recordset
Dim SeqNum As Integer
Dim Continue As Boolean
Dim RowNum As Integer
Dim CellToRead As String
Dim Pos, LastPos, FileLen As Integer

Dim ExcApp As New Excel.Application
Dim newWBooks As Excel.Workbooks

Set newWBooks = ExcApp.Workbooks

'Dim myAcces As New Access.Application
Dim myFD As FileDialog
'Dim myFname As String
'Dim myFPath As String

Set myFD = FileDialog(msoFileDialogOpen)

myFD.Filters.Add "Excel Files", "*.xls", 1
myFD.AllowMultiSelect = False

With myFD
If .Show = -1 Then
fileToOpen = .SelectedItems.Item(1)

newWBooks.Open fileToOpen

'-1 = user selected open
' do what you will with newWB
Else
'! -1 = User canxed
MsgBox ("You must select an Excel Workbook to continue.")
GoTo NoSelection
End If

End With

StrLen = Len(fileToOpen)
Pos = InStr(1, fileToOpen, "\")
LastPos = Pos
If Pos > 0 Then
Do
Pos = Pos + 1
LastPos = InStr(Pos, fileToOpen, "\")
If LastPos <> 0 Then
Pos = LastPos
End If
Loop Until LastPos = 0
End If
InFile = Mid(fileToOpen, Pos)

Set db = CurrentDb
' first populate the primary table - holds the most-frequently used data
Set rst = db.OpenRecordset("tblcold")
rst.AddNew
' starts with the data in the sheet1 sheet

ExcApp.Worksheets("Sheet1").Activate

'Worksheets("Sheet1").Activate

rst("PEODirectorate") = ExcApp.Worksheets("Sheet1").Range("A2").Value
rst("Profile") = ExcApp.Worksheets("Sheet1").Range("B2").Value
rst("System") = ExcApp.Worksheets("Sheet1").Range("C2").Value
rst("Hull") = ExcApp.Worksheets("Sheet1").Range("D2").Value
rst("HullNumber") = ExcApp.Worksheets("Sheet1").Range("E2").Value

rst.Update
rst.Close

' and that's everything - we can close the database and the workbook!

'Set newWSs = Nothing
newWBooks.Close
Set newWBooks = Nothing
ExcApp.Quit
Set ExcApp = Nothing
db.Close

MsgBox "Excel Workbook Import Successfully Completed"
'
NoSelection:
Exit_cmdStar_Click:
Exit Sub

Err_cmdStar_Click:
MsgBox Err.Description

Set newWSs = Nothing
newWBooks.Close
Set newWBooks = Nothing
ExcApp.Quit
Set ExcApp = Nothing
db.Close

Resume Exit_cmdStar_Click

End Sub

 

[PHV]

Did you consider the DoCmd.TransferSpreadsheet method ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[CoolFactor]

PHV,

I've tried this but it's not working properly. How can I incorporate this Docmd transfer method into the code that I already built. I really like the first part of my code because it allows the user to select whatever excel file they want.

Can you show me how to incorporate this transfer method into my code above or maybe show me a better way but allow users to select whatever excel file they want and then transfer those records into a new table created by access.

Thank you PHV, I've been trying to google this for quite some time.

 

[PHV]

A starting point:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "tblcold", fileToOpen, True

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[cjashwell]

PHV is right that the DoCmd.TransferSpreadsheet is probably the best way to accomplish what you need.

There are a number of other ways to do it, however. You could create a recordset from your Excel data and loop through that, appending each virtual row to your Access table.

There are also a couple of ways of doing this using Excel objects. Here is one (rather dirty!) way of doing it cribbed from a bit of code I use.

You should add lrows as integer and rngname as string to your declarations, and then you can add this into your exisitng code after Set rst = db.OpenRecordset("tblcold")

'Activate your worksheet
ExcApp.ActiveWorkbook.Worksheets("Sheet1").Activate
'establish the number of rows in your sheet
lrows = ExcApp.ActiveSheet.UsedRange.Rows.Count
rngname = "A1:E" & lrows 'create a range name based on the number of rows
ExcApp.ActiveWorkbook.Worksheets("Sheet1").Range(rngname).Select 'select your range in excel
For i = 2 To lrows 'start from 2 as you have a header
    rst.AddNew 'create new row in your access table
        rst![PEODirectorate] = ExcApp.Selection(i, 1).Value 'append each value in turn
        rst![Profile] = ExcApp.Selection(i, 2).Value
        rst![System] = ExcApp.Selection(i, 3).Value
        rst![Hull] = ExcApp.Selection(i, 4).Value
        rst![HullNumber] = ExcApp.Selection(i, 5).Value
    rst.Update 'update your access table
Next i 'move to next row in excel
rst.Close

This goes in before the comment ' and that's everything - we can close the database and the workbook!

Hope this helps.