Export from access to excel

[aman]

Hi All

The following code displays the total number of records and total records signed off for a particular date. It works fine. But now I want to display the details of records that are not signed off so that the client may know which records are those and can come to know why they are not signed off. I want to display everything all together in same excelsheet.

Dim strsql As String
strsql = "Select count(*) as [Total Recorded Items],count(Signoff) as [Total Items Signed Off] from completed_table where datevalue(Date1)=#" & Format(Date, "mm/dd/yyyy") & "#"
If DCount("Name", "MSysobjects", "Name='qrytemp' and type=5") > 0 Then
DoCmd.DeleteObject acQuery, "qrytemp"
End If
Set qdf = CurrentDb.CreateQueryDef("qrytemp", strsql)
    Dim objXls As Excel.Application
    Dim objWrkBk As Excel.Workbook
    Dim xprtFile As String
    xprtFile = "J:\Report.xls"
    DoCmd.OutputTo acOutputQuery, "qrytemp", acFormatXLS, xprtFile, False
        Set objXls = New Excel.Application
     objXls.Visible = False
     Const xlLandscape = 2
     Set objWrkBk = objXls.Workbooks.Open(xprtFile)
     objWrkBk.Sheets("qrytemp").Select
     Dim J As Integer
     J = objWrkBk.ActiveSheet.UsedRange.Rows.Count
      With objWrkBk.Sheets("qrytemp")
           .Application.Rows("1:1").Select
        .Application.Selection.Font.Bold = True
        '.Quit
        End With
         With objWrkBk.Sheets("qrytemp").PageSetup
            .LeftHeader = "Requested Date: " & Format(Date, "dd/mm/yyyy")
        .CenterHeader = "&""Arial,Bold""&14" & "Daily Report For Total Recorded Items Signed Off"
        .Orientation = xlLandscape
        
    End With
             objWrkBk.Sheets("qrytemp").Columns.AutoFit
             objWrkBk.PrintOut
             objWrkBk.Close savechanges:=False
             
             MsgBox "The Report has been printed off"
    Set objWrkBk = Nothing
    objXls.Quit
    
    Set objXls = Nothing
Set qdf = Nothing

I know we can write the following query:

strsql="Select * from tblmain where Signed=null"

But can we export the data all together in the same excelsheet Like the counting at the top and then after that records which are not signed off.

Thanks

 

[JamesMcS]

You could use your signed=null query as a recorset, then append the records to the open excel sheet:

Dim Rst as dao.recordset
Dim XLApp, XLBook, XLSheet As Object
Dim RowNumber As Integer
 
Set Rst = [COLOR=red][insert your query here][/COLOR]
Set XLApp = CreateObject("Excel.Application")
Set XLBook = XLApp.Workbooks.Add
Set XLSheet = XLBook.Worksheets("Sheet1")
 
 
XLSheet.range("A4").Select
For Each Field In Rst.Fields
    XLApp.activecell = Field.Name
    XLApp.activecell.offset(0, 1).Select
 
Next
 
'Append Data from recordset
 
Rownumber=5
 
XLSheet.range("A5").Select
 
Rst.MoveFirst
 
Do Until Rst.EOF
 
    For n = 0 To Rst.Fields.Count - 1
 
        XLApp.activecell = Rst.Fields(n)
        XLApp.activecell.offset(0, 1).Select
 
    Next
 
        Rst.MoveNext
        RowNumber = RowNumber + 1
        XLSheet.Cells(RowNumber, 1).Select
 
Else
 
Rst.MoveNext
 
Loop
XLApp.Visible = True

This is a snippet from one of my modules, edit as you see fit...

 

[aman]

Thanks for your reply. Can you please tell me why I am getting syntext error at :

Set Rst = db.OpenRecordset("select barcodevalue from completed_table where signed=" & Null)

Thanks

 

[JamesMcS]

Probably the & Null bit. Change it to WHERE Signed Is Null.

Usually what I do, especially with complex queries, is to use the query designer to make the query, switch to SQL view and copy and paste into code. But that's cheating

 

[DCrake]

Set Rst = db.OpenRecordset("select barcodevalue from completed_table where signed Is Null;")

 

[aman]

Now its giving me an error "Two few parameters, Expected 1!

Set Rst = db.OpenRecordset("select barcodevalue from completed_table where signed is Null")

Thanks

 

[JamesMcS]

What happens when you just try and run that query in SQL view? You're missing the semicolon from the end of the SQL statement as well.

 

[aman]

The query is working now. But can you please check the code again as it displays me "No record found".But the data is present in the table for that query.
I think the code that is appending data in the open sheet is giving some problem.

Private Sub Command11_Click()
Dim strsql As String
strsql = "Select count(*) as [Total Recorded Items],count(Signoff) as [Total Items Signed Off] from completed_table where datevalue(Date1)=#" & Format(Date, "mm/dd/yyyy") & "#"
If DCount("Name", "MSysobjects", "Name='qrytemp' and type=5") > 0 Then
DoCmd.DeleteObject acQuery, "qrytemp"
End If
Set qdf = CurrentDb.CreateQueryDef("qrytemp", strsql)
'need to add a reference to Microsoft Excel 11.0 (or the version you have) Object Library
    Dim objXls As Excel.Application
    Dim objWrkBk As Excel.Workbook
    Dim xprtFile As String
   'i = "select referenceid from completed_table where location='PWR' "
   
   xprtFile = "J:\Report5.xls"
    DoCmd.OutputTo acOutputQuery, "qrytemp", acFormatXLS, xprtFile, False
    'On Error GoTo 0
     Set objXls = New Excel.Application
     objXls.Visible = False
     Const xlLandscape = 2
     Set objWrkBk = objXls.Workbooks.Open(xprtFile)
     objWrkBk.Sheets("qrytemp").Select
     Dim J As Integer
     J = objWrkBk.ActiveSheet.UsedRange.Rows.Count
      With objWrkBk.Sheets("qrytemp")
           .Application.Rows("1:1").Select
        .Application.Selection.Font.Bold = True
        '.Quit
        End With
         With objWrkBk.Sheets("qrytemp").PageSetup
       ' .RightHeader = "Total Cases=" & J - 1
        .LeftHeader = "Requested Date: " & Format(Date, "dd/mm/yyyy")
        .CenterHeader = "&""Arial,Bold""&14" & "Daily Report For Total Recorded Items Signed Off"
        .Orientation = xlLandscape
        
    End With
             objWrkBk.Sheets("qrytemp").Columns.AutoFit
Dim Rst As DAO.Recordset
Dim XLApp, XLBook, XLSheet As Object
Dim RowNumber As Integer
Dim db As Database
Set db = CurrentDb
ssql = "SELECT completed_table.BarcodeValue, completed_table.Signoff, completed_table.Date1 FROM completed_table wHERE completed_table.Signoff Is Not Null AND datevalue(completed_table.Date1)=#" & Format(Date, "mm/dd/yyyy") & "#"
Set Rst = db.OpenRecordset(ssql)
'Set XLApp = CreateObject("Excel.Application")
'Set XLBook = XLApp.Workbooks.Add
'Set XLSheet = XLBook.Worksheets("qrytemp")
  
objWrkBk.Sheets("qrytemp").Range("A3").Select
For Each Field In Rst.Fields
    objXls.ActiveCell = Field.Name
    objXls.ActiveCell.Offset(0, 1).Select
 
Next
 
'Append Data from recordset
 
RowNumber = 3
 
objWrkBk.Sheets("qrytemp").Range("A3").Select
 
Rst.MoveFirst
 
Do Until Rst.EOF
 
    For n = 0 To Rst.Fields.Count - 1
 
        objXls.ActiveCell = Rst.Fields(n)
        objXls.ActiveCell.Offset(0, 1).Select
 
    Next
 
        Rst.MoveNext
        RowNumber = RowNumber + 1
        objWrkBk.Sheets("qrytemp").Cells(RowNumber, 1).Select
 
'Else
 
Rst.MoveNext
 
Loop
objXls.Visible = True
             
             objWrkBk.PrintOut
             objWrkBk.Close savechanges:=False
             
             MsgBox "The Report has been printed off"
    Set objWrkBk = Nothing
    objXls.Quit
    
    Set objXls = Nothing
Set qdf = Nothing
End Sub

 

[JamesMcS]

Does the query in ssql work OK by itself, if you run it with a date at the end instead of a variable?

 

[aman]

If I run the same query using query wizard then it works perfectly.

But it gives me runtime error 3021 No Current record when I run the whole code.

I think there is some problem in the code somewhere.

Thanks

 

[aman]

Hi James

My problem has been resolved. Just had to change the position of rst.movenext.

Thanks a lot for your help.

 

[JamesMcS]

Ah jolly good... knew it would need some messing about with, quite a useful bit of code though!