This is meant to keep myself from writing code again and again for each excel sheet i need to recurring upload in MS Access.
Still a WIP. Re-Writing code since i lost all my old Code.
Sub FromExcelToAccess()
'Exports data from the active worksheet to a table in an Access database
'this procedure must be edited before use
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("D:\Users\.....\Desktop\Excess Report.xls")
Set wks = wkb.Worksheets(1)
'ByVal TableNo As Long
Dim rs As Recordset
Set rs = New Recordset
rs.Open "Table2", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'All records in a table
r = 3 ' the start row in the worksheet
Do While Len(wks.Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
Tables Below: Structure Pic Attached:
' Add values to each field in the record using a Table with RowsSpec
For Each RecordOFROW In ListOfRows
.Fields(RecordOFROW![RowName/Column]) = wks.Range(RecordOFROW![Excel-Other] & r).Value
Next
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
'cn.Close
'Set cn = Nothing
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
Exit Sub
End Sub
Still a WIP. Re-Writing code since i lost all my old Code.
Sub FromExcelToAccess()
'Exports data from the active worksheet to a table in an Access database
'this procedure must be edited before use
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("D:\Users\.....\Desktop\Excess Report.xls")
Set wks = wkb.Worksheets(1)
'ByVal TableNo As Long
Dim rs As Recordset
Set rs = New Recordset
rs.Open "Table2", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
'All records in a table
r = 3 ' the start row in the worksheet
Do While Len(wks.Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
Tables Below: Structure Pic Attached:
' Add values to each field in the record using a Table with RowsSpec
For Each RecordOFROW In ListOfRows
.Fields(RecordOFROW![RowName/Column]) = wks.Range(RecordOFROW![Excel-Other] & r).Value
Next
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
Set rs = Nothing
'cn.Close
'Set cn = Nothing
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
Exit Sub
End Sub