Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How import excel data into Access Table using a command button.

Status
Not open for further replies.

CoolFactor

Technical User
Dec 14, 2006
110
US
Hello,

I just need a little help with VBA of how to get all the data from excel that pertains to each columns to the columns I have in an Access table. Currently its bringing only data in specific cells.

First here the part of the code I need help in and after this is the all of the code:

This is the part of the code I need help in:

rst("PEODirectorate") = ExcApp.Worksheets("Sheet1").Range("A") = rst!PEODirectorate
rst("Profile") = ExcApp.Worksheets("Sheet1").Range("B") = rst!Profile
rst("System") = ExcApp.Worksheets("Sheet1").Range("C") = rst!System
rst("Hull") = ExcApp.Worksheets("Sheet1").Range("D") = rst!Hull
rst("HullNumber") = ExcApp.Worksheets("Sheet1").Range("E") = rst!HullNumber


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 RMB Summary sheet

ExcApp.Worksheets("Sheet1").Activate

'Worksheets("Sheet1").Activate

rst("PEODirectorate") = ExcApp.Worksheets("Sheet1").Range("A") = rst!PEODirectorate
rst("Profile") = ExcApp.Worksheets("Sheet1").Range("B") = rst!Profile
rst("System") = ExcApp.Worksheets("Sheet1").Range("C") = rst!System
rst("Hull") = ExcApp.Worksheets("Sheet1").Range("D") = rst!Hull
rst("HullNumber") = ExcApp.Worksheets("Sheet1").Range("E") = rst!HullNumber


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



 
You may consider the DoCmd.TransferSpreadsheet method.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
do you how to fix this problem with the current code
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top