Taking Access data and putting it into Excel (1 Viewer)

JoeGKushner

New member
Local time
Today, 12:48
Joined
Jun 23, 2015
Messages
9
I have a database that had some code that enabled the user to click a button and it would take information from one Access query or table and paste it into specific locations in Excel. This is important because the last worksheet has specific formatting in place.

If it didn't, I'd just use the transfer spreadsheet option and not even bother opening Excel at all with code.

I've got it working well except for the last part. The last query being copied has eight records and only one is being sent to Excel. Same code as the other queries where all of their data is going to the right spot in Excel with the right number of records.

Any help would be appreciated.

Private Sub AM_Top_25_Click()
DoCmd.SetWarnings False
DoCmd.OpenQuery "delete_ShortPartItems", acNormal, acEdit
DoCmd.OpenQuery "append_to_Short_Part_Items", acNormal, acEdit

Dim Db As Database
Dim Rst As Recordset
Set Db = Nothing
Dim xlApp As Object
Dim strWhat As String, boolXL As Boolean
Dim objActiveWkb As Object
Dim fldCount As Integer
Dim recCount As Long
Dim iCol As Integer
Dim iRow As Integer
Dim recArray As Variant
Dim xlWb As Object
Dim xlWs As Object
Dim pCount As Integer
Dim pTest As String

boolXL = True

Set Db = CurrentDb

'Top 25 Query With Information from WIP Tab
Set Rst = Db.OpenRecordset("AftTop25_From_pcPsub_Details")
pCount = Rst.RecordCount
Set xlApp = CreateObject("excel.Application")
Set xlWb = xlApp.workbooks.Open("S:\PURCHASE\USERS\PCiufo\backup\Aftermarket_Top_25Template.xls ")
Set xlWs = xlWb.worksheets("Priority $")

xlApp.Visible = True
xlApp.UserControl = True
fldCount = Rst.Fields.Count
recArray = Rst.GetRows(pCount)
recCount = UBound(recArray, 2) + 1

'Dumps data into Rows and Columns
xlWs.cells(2, 1).Resize(recCount, fldCount).Value = TransposeDim(recArray)

Rst.Close

Set Rst = Db.OpenRecordset("Report_4 DocumnetDirect")
pCount = Rst.RecordCount
Set xlWs = xlWb.worksheets("Wip-PO")
xlApp.Visible = True
xlApp.UserControl = True
fldCount = Rst.Fields.Count
recArray = Rst.GetRows(pCount)
recCount = UBound(recArray, 2) + 1
xlWs.cells(2, 1).Resize(recCount, fldCount).Value = TransposeDim(recArray)
Rst.Close

Set Rst = Db.OpenRecordset("zqry03_UnitSummary_From_pcPsub")
pCount = Rst.RecordCount
Set xlWs = xlWb.worksheets("Summary")
xlApp.Visible = True
xlApp.UserControl = True
fldCount = Rst.Fields.Count
recArray = Rst.GetRows(pCount)
recCount = UBound(recArray, 2) + 1
xlWs.cells(5, 1).Resize(recCount, fldCount).Value = TransposeDim(recArray)
Rst.Close

Set Rst = Db.OpenRecordset("zqry02_MakePlannerSummary_From_pcPsub")
pCount = Rst.RecordCount
Set xlWs = xlWb.worksheets("Summary")
xlApp.Visible = True
xlApp.UserControl = True
fldCount = Rst.Fields.Count
recArray = Rst.GetRows(pCount)
recCount = UBound(recArray, 2) + 1
xlWs.cells(5, 4).Resize(recCount, fldCount).Value = TransposeDim(recArray)
Rst.Close

Set Rst = Db.OpenRecordset("zqry01_VendorSummary_From_pcPsub")
pCount = Rst.RecordCount
Set xlWs = xlWb.worksheets("Summary")
xlApp.Visible = True
xlApp.UserControl = True
fldCount = Rst.Fields.Count
recArray = Rst.GetRows(pCount)
recCount = UBound(recArray, 2) + 1
xlWs.cells(5, 8).Resize(recCount, fldCount).Value = TransposeDim(recArray)
Rst.Close


Set Rst = Nothing

DoCmd.SetWarnings True
End Sub


The function that it's calling TransposeDim is

Function TransposeDim(v As Variant) As Variant

Dim x As Long
Dim Y As Long
Dim Xupper As Long
Dim Yupper As Long
Dim tempArray As Variant

Xupper = UBound(v, 2)
Yupper = UBound(v, 1)

ReDim tempArray(Xupper, Yupper)
For x = 0 To Xupper
For Y = 0 To Yupper
tempArray(x, Y) = v(Y, x)
Next Y
Next x

TransposeDim = tempArray
End Function
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 10:48
Joined
Aug 30, 2003
Messages
36,118
Have you stepped through the code and made sure the proper record count was returned? In my experience, you can't count on RecordCount returning the correct value without having an rst.MoveLast.
 

JoeGKushner

New member
Local time
Today, 12:48
Joined
Jun 23, 2015
Messages
9
That was the problem. I 'fixed' it by throwing another snippet of code in.

If Rst.AbsolutePosition > -1 Then
'Move to the last row
Rst.MoveLast

'Now get the count
pCount = Rst.RecordCount

'If you want, you can now move again
Rst.MoveFirst

'----
'Continue processing
'----

End If
 

pbaldy

Wino Moderator
Staff member
Local time
Today, 10:48
Joined
Aug 30, 2003
Messages
36,118
Glad it helped.
 

Users who are viewing this thread

Top Bottom