Query current view in form

[smikkelsen]

I have a command button that when clicked should export the current filtered records (on a form) to an excel template.

I found some code and modified it a little bit to work with what I am doing, but the only problem is that I cannot figure out a way to export only the current listed records. The form is based of a table, not a query. The form filters itself in the form query builder by foUser, so I can't just use the table in this export code, otherwise it will export thousands of records rather than just a few dozen.

Here is the code I am playing with:

 
 
 
 
On Error GoTo err_Handler
   MsgBox ExportRequest, vbInformation, "Finished"
   Application.FollowHyperlink CurrentProject.Path & "\ExportedSites.xlsx"
exit_Here:
   Exit Sub
err_Handler:
   MsgBox Err.Description, vbCritical, "Error"
   Resume exit_Here
End Sub
 
 
 
 
Public Function ExportRequest() As String
   On Error GoTo err_Handler
 
   ' Excel object variables
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
   Dim sTemplate As String
   Dim sTempFile As String
   Dim sOutput As String
 
   Dim dbs As DAO.database
   Dim rst As DAO.Recordset
   Dim sSQL As String
   Dim lRecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer
 
   Const cTabTwo As Byte = 1
   Const cStartRow As Byte = 6
   Const cStartColumn As Byte = 3
 
   DoCmd.Hourglass True
 
   ' set to break on all errors
   Application.SetOption "Error Trapping", 2
 
   ' start with a clean file built from the template file
   sTemplate = CurrentProject.Path & "\ExportTemplate.xlsx"
   sOutput = CurrentProject.Path & "\ExportedSites.xlsx"
   If Dir(sOutput) <> "" Then Kill sOutput
   FileCopy sTemplate, sOutput
 
   ' Create the Excel Applicaiton, Workbook and Worksheet and Database object
   Set appExcel = New Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
   Set wks = appExcel.Worksheets(cTabTwo)
 
 
   sSQL = "select * from qryDummy"
   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
   If Not rst.BOF Then rst.MoveFirst
 
   ' For this template, the data must be placed on the 4th row, third column.
   ' (these values are set to constants for easy future modifications)
   iCol = cStartColumn
   iRow = cStartRow
 
   Do Until rst.EOF
      iFld = 0
      lRecords = lRecords + 1
     ' Me.lblMsg.Caption = "Exporting record #" & lRecords & " to SalesOutput.xls"
      'Me.Repaint
 
      For iCol = cStartColumn To cStartColumn + (rst.Fields.Count - 1)
         wks.Cells(iRow, iCol) = rst.Fields(iFld)
 
         If InStr(1, rst.Fields(iFld).Name, "Date") > 0 Then
            wks.Cells(iRow, iCol).NumberFormat = "mm/dd/yyyy"
         End If
 
         wks.Cells(iRow, iCol).WrapText = False
         iFld = iFld + 1
      Next
 
      wks.Rows(iRow).EntireRow.AutoFit
      iRow = iRow + 1
      rst.MoveNext
   Loop
 
   'ExportRequest = "Total of " & lRecords & " rows processed."
   'Me.lblMsg.Caption = "Total of " & lRecords & " rows processed."
 
exit_Here:
   ' Cleanup all objects  (resume next on errors)
   On Error Resume Next
   Set wks = Nothing
   Set wbk = Nothing
   Set appExcel = Nothing
   Set rst = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
 
err_Handler:
   ExportRequest = Err.Description
   'Me.lblMsg.Caption = Err.Description
   Resume exit_Here
 
End Function

Is there a way to replace this line here:

sSQL = "select * from qryDummy"

with something that will grab the current view on the form? Lets say the form has 100 records when you open it (filtered down from thousands using the foUsername). Then if the user can filter those records by something else, leaving only 10 records left in view; How can I get that sql string to select those records?

Thanks

[TheShabz]

This sounds similar to an issue I had. This may be a shot in the dark, but have you tried opening a recordset containing the filtered results then using transferspreadsheet or however else you want to export on that recordset?

[smikkelsen]

I wish it were that simple. Or perhaps I am doing it completely wrong, but I just tried this:

   'sSQL = "select * from qryDummy"
   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset("Main_Tracking", dbOpenDynaset)
   'Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
   If Not rst.BOF Then rst.MoveFirst

And about 20 min. later, it was done looping, and it exported 3000 plus sites to the template. This is every record in the table unfortunately. I'm just not sure how to limit that to what is currently filtered in the form i'm using rather than just spit out everything.

Let me know if i'm doing it wrong. I'm still in that frustrating learning stage of knowing a few things off hand, but mostly have to find existing vba and customize it.

Thanks!

[TheShabz]

set rst = dbs.openrecordset (and apply filter here)
Again, I'm not sure it will work. Just an idea. Hopefully someone with more experience can provide more input here.

[maximus]

Smik No I have done something for you. I have created a Query using CreateQueryDef and then used it to transfer the data on to an excel file. I have used Simple SQl to create the Syntax for my Query save it in my database exported it to an excel file.

This will solve the Filtering problem.

After the transfer is complete I have deleted the query this ensures that you get no error next time when you run the code.

Code:

Private Sub Command0_Click()
On Error GoTo Err_Command0_Click

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim qr As DAO.QueryDef

'//////////////////////////////////////////////////////
'/ Modified by Siddthartha Majumdar on 04/30/2010 /
'/ Scope Creating a custom transfer of Data from /
'/ /
'//////////////////////////////////////////////////


'Creatin a Query using a CreateQuery Def


strSQL = "Select * From Issues_All Where ID=" & 5
Set qr = CurrentDb.CreateQueryDef("qryProject", strSQL)


'Opening a RecordSet that is the Query Created

Set db = CurrentDb
Set rs = db.OpenRecordset("qryProject", dbOpenSnapshot)

'Starting a new workbook in Excel


Dim oApp As New Excel.Application
Dim oBook As Excel.Workbook
Dim oSheet As Excel.Worksheet

Set oBook = oApp.Workbooks.Add
Set oSheet = oBook.Worksheets(1)

'The First Row in the workSheet will be populated by the
Dim i As Integer
Dim iNumCols As Integer
iNumCols = rs.Fields.Count
For i = 1 To iNumCols
oSheet.Cells(1, i).Value = rs.Fields(i - 1).Name
Next

'Add the data starting at cell A2
oSheet.Range("A2").CopyFromRecordset rs

'Format the header row as bold and autofit the columns
With oSheet.Range("a1").Resize(1, iNumCols)
.Font.Bold = True
.EntireColumn.AutoFit
End With

oApp.Visible = True
oApp.UserControl = True

'Close the Database and Recordset
rs.Close
db.Close

'Deleting the Query created
CurrentDb.QueryDefs.Delete "qryProject"

Exit_Command0_Click:
Exit Sub

Err_Command0_Click:
MsgBox Err.Description
Resume Exit_Command0_Click

End Sub

[maximus]

I have used the sql to filter my Records. Use the where condition to limit records.

[maximus]

is your problem solved did my post help you any way??????