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 strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Open Excel and find range to copy into Access 2007 Table for multiple tabs

Status
Not open for further replies.

kimpal

Technical User
Oct 16, 2012
17
US
Hello,
I have an Excel 2007 macro enabled file (xlsm) that has records in which the number of rows will change each week.
The file has 3 tabs, each need to be imported into a separatte table. Each tab has a fixed number of columns

tab1 Shipment Tracker into tblShipmentTracker
There are 46 columns that need to be transferred into the 46 corresponding fields in the Access table
I do have a dynamic named range in the Shipment Tracker tab which is called 'Shipment_Import

tab2 Cost into tblCost
There are 51 colulmns that need to be transferred into the 51 corresponding fields in the Access table

tab3 Invoice Tracker into tblInvoiceTracker
There are 65 colulmns that need to be transferred into the 65 corresponding fields in the Access table

I am running into issues of formatting and automating the import into an existing table.
I have found the below code but am not sure how to use it correctly.
I have gotten to the line "Set wb = Workbooks.Open(FN, True, True)" successfully, after that I get this error:
"Runtime Error 1004"
"Application defined or object defined error"
when I debug, it highlights the following line:
Do Until wb.Worksheets("Shipment Tracker").Range("Shipment_Import_Range").Formula = ""


Code Start:
"Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
Dim db As Database, rec As Recordset
'Dim wb As Workbook
Dim x As String, y As String, z As String
Dim A As String, B As String, C As String

Set db = CurrentDb
Set rec = db.OpenRecordset("tblShipmentTracker")
Dim FN As String
FN = "C:\Documents and Settings\KPA004\Desktop\DYNCORP\Standard Template\Dyncorp_Standard_Template_Inbound_v6.xlsm"
'Forms!mainmenu!Child2.Form!MyDirectory & Forms!mainmenu!Child2.Form.Form!mycombobox

Set wb = Workbooks.Open(FN, True, True)
' open the source workbook, read only
Do Until wb.Worksheets("Shipment Tracker").Range("Shipment_Import_Range").Formula = ""
x = wb.Worksheets("Shipment Tracker").Range(A).Formula
y = wb.Worksheets("Sheet1").Range(B).Formula
z = wb.Worksheets("Sheet1").Range(C).Formula
rec.AddNew
rec.Fields("Field1") = x
rec.Fields("Field2") = y
rec.Fields("Field3") = z
rec.Update

i = i + 1
A = "A" & i
B = "B" & i
C = "C" & i
Loop
wb.Close False ' close the source workbook without saving any changes
Set wb = Nothing ' free memory
rec.Close
db.Close
End Sub"
Code END

 
I found some code that works great.
I just need help to Loop it now.
It should start at Row 12
column A = tbl.field.A, add new record and update field with value from Excel
go to next column, column B = tblfield.b and update field with value from Excel
once all columns are completed (there is a fixed number of columns), go to next row
Loop

Here is the code that just needs the loop statements:
Start Code[]
Sub ADD()
Dim myRec As DAO.Recordset

Dim xl As Excel.Application
Dim xlsht As Excel.Worksheet
Dim xlWrkBk As Excel.Workbook
Dim FN As String

FN = "C:\Documents and Settings\KPA004\Desktop\DYNCORP\Standard Template\Dyncorp_Standard_Template_Inbound_v6.xlsm"
Set myRec = CurrentDb.OpenRecordset("tblShipmentTracker")

Set xl = CreateObject("Excel.Application")
Set xlWrkBk = GetObject(FN)
Set xlsht = xlWrkBk.Worksheets(2)

myRec.AddNew
myRec.Fields("Program") = xlsht.Cells(12, "B")
myRec.Fields("MOT") = xlsht.Cells(12, "C")
myRec.Fields("Route_Category") = xlsht.Cells(12, "D")
myRec.Fields("Import_Date_Time") = Now()
myRec.Fields("OriginalFilePath") = FN
myRec.Update
End Sub
End Code []
 
I don't know how you are setting your upper row limit, but this should give you a general idea

Dim i as integer

For i= 12 to numRows
myRec.AddNew
myRec.Fields("Program") = xlsht.Cells(i, "B")
myRec.Fields("MOT") = xlsht.Cells(i, "C")
myRec.Fields("Route_Category") = xlsht.Cells(i, "D")
myRec.Fields("Import_Date_Time") = Now()
myRec.Fields("OriginalFilePath") = FN
myRec.Update

next i
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top