Help with an array

Skip Bisconer

Who Me?
Local time
Yesterday, 17:15
Joined
Jan 22, 2008
Messages
285
I am using this to populate a spreadsheet but my data is way to large (10,000+ lines in 31 columns) to use this effectively. Help indicates transfering data in an array is the best way to go but I can't figure out from their example how set this data from a query into an array. Below is my code I am using now.

Code:
Function FillWSInvAnalLoc1()
 
    ' Direct procedure flow.
'On Error GoTo ErrorHandler
 
Dim objXL As Object
Dim xlWB As Object
Dim xlWS As Object
Set objXL = CreateObject("Excel.Application")
objXL.Visible = True
Set xlWB = objXL.Workbooks.Open("C:\Inventory\XLInventoryAnalysisLoc1.xlsm")
Set xlWS = xlWB.Worksheets("InvAnalysis")
'xlWB.Worksheets("InvAnalysis").Unprotect Password:=("1234")
 
Dim db As Database
Dim rs As Recordset
Dim i As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("qryInventoryAnalysisLoc1", , dbOpenDynamic)
rs.MoveFirst
i = 2
Do Until rs.EOF
  With xlWS
  ' assign records to specific cells
  .Range("A" & i).Value = rs.Fields("Part").Value
  .Range("B" & i).Value = rs.Fields("Description").Value
  .Range("C" & i).Value = rs.Fields("VCode").Value
  .Range("D" & i).Value = rs.Fields("WhsLocation").Value
  .Range("E" & i).Value = rs.Fields("VendorID").Value
  .Range("F" & i).Value = rs.Fields("VendUOM").Value
  .Range("G" & i).Value = rs.Fields("VendItemMinOrd").Value
  .Range("H" & i).Value = rs.Fields("InventoryCost").Value
  .Range("I" & i).Value = rs.Fields("InventoryList").Value
  .Range("J" & i).Value = rs.Fields("QtyOnOrder").Value
  .Range("K" & i).Value = rs.Fields("QtyOnBackOrder").Value
  .Range("L" & i).Value = rs.Fields("QtyOnHand").Value
  .Range("M" & i).Value = rs.Fields("QtyMin").Value
  .Range("N" & i).Value = rs.Fields("QtyMax").Value
  .Range("O" & i).Value = rs.Fields("AvgMo").Value
  .Range("P" & i).Value = rs.Fields("ListMargin").Value
  .Range("Q" & i).Value = rs.Fields("LeadTime").Value
  .Range("R" & i).Value = rs.Fields("ReviewCycle").Value
  .Range("S" & i).Value = rs.Fields("CarryCost").Value
  .Range("T" & i).Value = rs.Fields("ReplenishmentCosts").Value
  .Range("U" & i).Value = rs.Fields("SurplusStock").Value
  .Range("V" & i).Value = rs.Fields("SA").Value
  .Range("W" & i).Value = rs.Fields("SAPcnt").Value
  .Range("X" & i).Value = rs.Fields("SP").Value
  .Range("Y" & i).Value = rs.Fields("EOQ").Value
  .Range("Z" & i).Value = rs.Fields("Calc1").Value
  .Range("AA" & i).Value = rs.Fields("Calc2").Value
  .Range("AB" & i).Value = rs.Fields("Calc3").Value
  .Range("AC" & i).Value = rs.Fields("LP").Value
  .Range("AD" & i).Value = rs.Fields("OP").Value
  .Range("AE" & i).Value = rs.Fields("RecBuyQty").Value
 
 
  End With
i = i + 1
rs.MoveNext
Loop
'Run Sheet 2 first
objXL.Application.Run "XLInventoryAnalysisLoc1.xlsm!FormatNewTable"
'xlWB.Worksheets("CurrentCharges").Protect Password:=("1234")
'objXL.activeworkbook.Save
'objXL.Application.Quit
'objXL.Application = Nothing
 rs.Close
 db.Close
 
  Exit Function
 
End Function
 
Interop can be slow. If you can do this in pure Access, it might run faster. Here's a code snippet in my notebook although i've never tried it myself. Supposedly it can export data from the Customers table to a specific range of cells.

DoCmd.TransferSpreadsheet acExport, 8, "Customers", pathToSpreadsheet, True, "MainSheet!C4:E6"
 
Have a look at help for GetRows
 
ADO GetRows Method

Complete Recordset Object Reference The GetRows method copies multiple records from a Recordset object into a two-dimensional array.
Syntax

vararray=objRecordset.GetRows(rows,start,fields)
Parameter Description rows Optional. A GetRowsOptionEnum value that specifies the number of records to retrieve. Default is adGetRowsRest.Note: If you omit this argument it will retrieve all records in the Recordset
start Optional. What record to start on, a record number or a BookmarkEnum value
fields Optional. If you want to specify only the fields that the GetRows call will return, it is possible to pass a single field name/number or an array of field names/numbers in this argument Example

<%
set conn=Server.CreateObject("ADODB.Connection")
conn.Provider="Microsoft.Jet.OLEDB.4.0"
conn.Open(Server.Mappath("northwind.mdb"))
set rs = Server.CreateObject("ADODB.recordset")
rs.Open "Select * from Customers", conn

'The first number indicates how many records to copy
'The second number indicates what recordnumber to start on
p=rs.GetRows(2,0)
rs.close
conn.close 'This example returns the value of the first
'column in the first two records
response.write(p(0,0))
response.write("<br />")
response.write(p(0,1))

'This example returns the value of the first
'three columns in the first record
response.write(p(0,0))
response.write("<br />")
response.write(p(1,0))
response.write("<br />")
response.write(p(2,0))
%>
 
The code given above is ASP (for web pages) but you can use ADO in access.

You need to set the reference to Microsoft ActiveX Data Objects in the references section from a code module. Open a module, go to tools references and set the reference as shown in the attached image.
 

Attachments

  • referenceADO.GIF
    referenceADO.GIF
    20 KB · Views: 119
Can this be achieved using the CopyFromRecordset method? Not sure if it is quicker, but it'd certainly mean less lines of code implying perhaps it'd run quicker?
 
Thanks for all the input. Unfortunately it's way over my head. I think what I will try is export to an .xls or .csv file then have Excel import into the corret sheet. Then I can handle all the XL stuff right from Access. I just I believe that should be a lot faster than inputing cell by cell. I have code that has to stay with the XL workboos so I must reuse the same workbook each time.

I tried the docmd mentioned by JA so this is to let him know it didn't work. It kept dying on the sheetname and cell references.

I need to tear into my many VBA books and learn more on my own but time just flies, the needs are unending and the desire seems immediate. If you know what I mean.

I appreciate all the imput from this forum. There are some really great thinkers out there.
 

Users who are viewing this thread

Back
Top Bottom