Rx_
Nothing In Moderation
- Local time
 - Today, 05:29
 
- 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