Rx_
Nothing In Moderation
- Local time
- Yesterday, 23:39
- Joined
- Oct 22, 2009
- Messages
- 2,803
PNG - create a table with this design (NOTE: NO Primary Key)
.XLS NOTICE - change the extension to .XLSX (this site won't allow .xlsx extensions to be uploaded - so change it back to avoid an error)
In Code window menu - Tools -> Reference -> check on MS Excel
Put this code in Access Module: in immediate window - run the BasicImportExcel2Access
Note: The Access table probably won't automatically refresh.
.XLS NOTICE - change the extension to .XLSX (this site won't allow .xlsx extensions to be uploaded - so change it back to avoid an error)
In Code window menu - Tools -> Reference -> check on MS Excel
Put this code in Access Module: in immediate window - run the BasicImportExcel2Access
Note: The Access table probably won't automatically refresh.
Code:
Option Compare Database
Option Explicit
' in code window menu Tools - Reference - must have Excel checked
Sub BasicImportExcel2Access()
Dim xlsht As Excel.Worksheet
Dim xlWrkBk As Excel.Workbook
Dim myRec As DAO.Recordset
Dim xlApp As Excel.Application
Dim xlWrksht As Excel.Worksheet
Dim i As Long
10 Set myRec = CurrentDb.OpenRecordset("XLImportTest")
20 Set xlApp = CreateObject("Excel.Application")
30 Set xlWrkBk = xlApp.Workbooks.Open("C:\ImportDemo.xlsx") ' Path can be a variable from a list in a table
40 Set xlWrksht = xlWrkBk.Sheets(1) ' 1 can be a variable to loop 1..10 for example
50 For i = 2 To 10
60 myRec.AddNew
70 On Error Resume Next
80 myRec.Fields(0) = xlWrksht.Cells(i, "A") ' CInt(xlWrksht.Cells(i, "A")) if conversion necessary
90 myRec.Fields(1) = xlWrksht.Cells(i, "B")
100 myRec.Fields(2) = xlWrksht.Cells(i, "C")
110 myRec.Update
120 Next
121 Set myRec = Nothing
122 Set xlApp = Nothing
130 Exit Sub
' add some real error trapping
End Sub