Full Version: Copyfromrecordset Does Copy All Records To The Worksheet
UtterAccess Discussion Forums > Microsoft® Access > Access Automation
Kamulegeya
Apr 27 2012, 01:28 PM
Hello UA Members


I have a procedure below to export data to an excel worksheet.

If i run the result of the debug.Print strSQL in the query designer , i get all the records but the copyfromrecordset returns not all the records.

e.g it may return like 10 rows yet the rows are 100.

Here is the code
CODE
Private Sub cmdSummary_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim objApp As Excel.Application
Dim objBook As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim strSQL As String
Dim i As Integer
On Error GoTo ErrorHandle
If Me.lstPeriods.ItemsSelected.Count = 0 Then
MsgBox " No Period Selected. Select a period to proceed", vbExclamation
Exit Sub
End If
strSQL = "SELECT qryTotalPaid.Contractor," & _
         " qryTotalPaid.SectionNumber, " & _
         " qryTotalPaid.SectionLength," & _
         " qryTotalPaid.RoadName," & _
         " qryTotalPaid.PackageRef, " & _
         " qryTotalPaid.PlannedAmount," & _
         " qryTotalPaid.ActualAmount," & _
         "Format( Nz([qryTotalPaid]![ActualAmount],0)/Nz([qryTotalPaid]![PlannedAmount],0),'Percent') AS [%Paid]" & _
         " From qryTotalPaid " & _
         " Where PeriodID = " & Me.lstPeriods.Column(0)
        Debug.Print strSQL
Set db = CurrentDb()
Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
If Not rst.EOF Then
''''start excel
Set objApp = New Excel.Application
objApp.Visible = True
Set objBook = objApp.Workbooks.Add
Set objSheet = objBook.Worksheets("Sheet1")
objApp.ScreenUpdating = False
objSheet.Select
objSheet.Range("A2").CopyFromRecordset rst
    For i = 1 To rst.Fields.Count
    objSheet.Cells(1, i).Value = rst.Fields(i - 1).Name
    Next i    '''' do some formating
objSheet.UsedRange.EntireColumn.AutoFit
With objApp
   .Range("F:G").Style = "Comma [0]"
   .Range("1:1").Font.Bold = True
   .Range("D:D").AutoFilter
End With
  
Else
MsgBox " No Record to Export", vbInformation
GoTo myExit
End If
myExit:
On Error Resume Next
objApp.ScreenUpdating = True
rst.Close
Set rst = Nothing
Set db = Nothing
Set objSheet = Nothing
Set objBook = Nothing
If Not objApp Is Nothing Then
Set objApp = Nothing
    End If
Exit Sub
ErrorHandle:
MsgBox "Error:" & Err.Description & " ErrorNumbr:" & Err.number
Resume myExit
End Sub


what is the problem?

Ronald

Failed to edit the heading but i mean " Does not copy all records"
DanielPineault
Apr 27 2012, 01:53 PM
You might try moving to the last record before performing the export.

CODE
Private Sub cmdSummary_Click()
    Dim rst             As DAO.Recordset
    Dim db              As DAO.Database
    Dim objApp          As Excel.Application
    Dim objBook         As Excel.Workbook
    Dim objSheet        As Excel.Worksheet
    Dim strSQL          As String
    Dim i               As Integer
    On Error GoTo ErrorHandle
    If Me.lstPeriods.ItemsSelected.Count = 0 Then
        MsgBox " No Period Selected. Select a period to proceed", vbExclamation
        Exit Sub
    End If
    strSQL = "SELECT qryTotalPaid.Contractor," & _
             " qryTotalPaid.SectionNumber, " & _
             " qryTotalPaid.SectionLength," & _
             " qryTotalPaid.RoadName," & _
             " qryTotalPaid.PackageRef, " & _
             " qryTotalPaid.PlannedAmount," & _
             " qryTotalPaid.ActualAmount," & _
             "Format( Nz([qryTotalPaid]![ActualAmount],0)/Nz([qryTotalPaid]![PlannedAmount],0),'Percent') AS [%Paid]" & _
             " From qryTotalPaid " & _
             " Where PeriodID = " & Me.lstPeriods.Column(0)
    Debug.Print strSQL
    Set db = CurrentDb()
    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
    If rst.RecordCount <> 0 Then
        rst.MoveLast
        rst.MoveFirst
        ''''start excel
        Set objApp = New Excel.Application
        objApp.Visible = True
        Set objBook = objApp.Workbooks.Add
        Set objSheet = objBook.Worksheets("Sheet1")
        objApp.ScreenUpdating = False
        objSheet.Select
        objSheet.Range("A2").CopyFromRecordset rst
        For i = 1 To rst.Fields.Count
            objSheet.Cells(1, i).Value = rst.Fields(i - 1).Name
        Next i    '''' do some formating
        objSheet.UsedRange.EntireColumn.AutoFit
        With objApp
            .Range("F:G").Style = "Comma [0]"
            .Range("1:1").Font.Bold = True
            .Range("D:D").AutoFilter
        End With
    Else
        MsgBox " No Record to Export", vbInformation
        GoTo myExit
    End If

myExit:
    On Error Resume Next
    objApp.ScreenUpdating = True
    rst.Close
    Set rst = Nothing
    Set db = Nothing
    Set objSheet = Nothing
    Set objBook = Nothing
    If Not objApp Is Nothing Then
        Set objApp = Nothing
    End If
    Exit Sub

ErrorHandle:
    MsgBox "Error:" & Err.Description & " ErrorNumbr:" & Err.Number
    Resume myExit
End Sub
Kamulegeya
Apr 27 2012, 02:04 PM
QUOTE (DanielPineault @ Apr 27 2012, 09:53 PM) *
You might try moving to the last record before performing the export.

CODE
Private Sub cmdSummary_Click()
    Dim rst             As DAO.Recordset
    Dim db              As DAO.Database
    Dim objApp          As Excel.Application
    Dim objBook         As Excel.Workbook
    Dim objSheet        As Excel.Worksheet
    Dim strSQL          As String
    Dim i               As Integer
    On Error GoTo ErrorHandle
    If Me.lstPeriods.ItemsSelected.Count = 0 Then
        MsgBox " No Period Selected. Select a period to proceed", vbExclamation
        Exit Sub
    End If
    strSQL = "SELECT qryTotalPaid.Contractor," & _
             " qryTotalPaid.SectionNumber, " & _
             " qryTotalPaid.SectionLength," & _
             " qryTotalPaid.RoadName," & _
             " qryTotalPaid.PackageRef, " & _
             " qryTotalPaid.PlannedAmount," & _
             " qryTotalPaid.ActualAmount," & _
             "Format( Nz([qryTotalPaid]![ActualAmount],0)/Nz([qryTotalPaid]![PlannedAmount],0),'Percent') AS [%Paid]" & _
             " From qryTotalPaid " & _
             " Where PeriodID = " & Me.lstPeriods.Column(0)
    Debug.Print strSQL
    Set db = CurrentDb()
    Set rst = db.OpenRecordset(strSQL, dbOpenSnapshot)
    If rst.RecordCount <> 0 Then
        rst.MoveLast
        rst.MoveFirst
        ''''start excel
        Set objApp = New Excel.Application
        objApp.Visible = True
        Set objBook = objApp.Workbooks.Add
        Set objSheet = objBook.Worksheets("Sheet1")
        objApp.ScreenUpdating = False
        objSheet.Select
        objSheet.Range("A2").CopyFromRecordset rst
        For i = 1 To rst.Fields.Count
            objSheet.Cells(1, i).Value = rst.Fields(i - 1).Name
        Next i    '''' do some formating
        objSheet.UsedRange.EntireColumn.AutoFit
        With objApp
            .Range("F:G").Style = "Comma [0]"
            .Range("1:1").Font.Bold = True
            .Range("D:D").AutoFilter
        End With
    Else
        MsgBox " No Record to Export", vbInformation
        GoTo myExit
    End If

myExit:
    On Error Resume Next
    objApp.ScreenUpdating = True
    rst.Close
    Set rst = Nothing
    Set db = Nothing
    Set objSheet = Nothing
    Set objBook = Nothing
    If Not objApp Is Nothing Then
        Set objApp = Nothing
    End If
    Exit Sub

ErrorHandle:
    MsgBox "Error:" & Err.Description & " ErrorNumbr:" & Err.Number
    Resume myExit
End Sub


Hello Daniel

Tried it . It exports the last row in the recordset .

I have similar code in other modules working. I simply copied and pasted

Ronald
DanielPineault
Apr 27 2012, 02:43 PM
It will return only the last row if you don't not perform a .MoveFirst before the export as per my code. Did you actually try my code or are you merely talking about your past trials?
Kamulegeya
Apr 27 2012, 02:51 PM
QUOTE (DanielPineault @ Apr 27 2012, 10:43 PM) *
It will return only the last row if you don't not perform a .MoveFirst before the export as per my code. Did you actually try my code or are you merely talking about your past trials?


Hello Daniel

Made the changes you suggested and got only the last row exported.

I think there might be a problem with this line

CODE
"Format( Nz([qryTotalPaid]![ActualAmount],0)/Nz([qryTotalPaid]![PlannedAmount],0),'Percent') AS [%Paid]" & _


where is both numerator and denominator are zero(an overflow problem)

How can i eliminate it?
Kamulegeya
Apr 27 2012, 03:09 PM
Changed the calculation to

CODE
"IIF(Nz([qryTotalPaid]![PlannedAmount],0)=0,0,Format( Nz([qryTotalPaid]![ActualAmount],0)/Nz([qryTotalPaid]![PlannedAmount],0),'Percent')) AS [%Paid]" & _



and it is working


This is a "lo-fi" version of our main content. To view the full version with more information, formatting and images, please click here.