Export query data

Export query data from access to Excel spreadsheet

Page 1 of 1

1 Replies - 2373 Views - Last Post: 19 October 2010 - 11:18 AM Rate Topic: -----

#1 PrestonGoh  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 1
  • Joined: 05-October 10

Export query data

Posted 19 October 2010 - 01:58 AM

I have a project to import DP data into Access db, massage the data and export it into excel spreadsheet.

The following able to create excel file with the cell manager filename but do not why it keep repeat on same cell manager.

The briefing for this coding purpose.

I want to create an excel file with "CM" where the media is belong to POOL inside LIBRARY.

Expertise Please help....
-------------------------

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 rst_CM As DAO.Recordset
   Dim rst_CM_count As DAO.Recordset
   Dim sSQL_CM As String
   Dim sSQL As String
   Dim lRecords As Long
   Dim iRow As Integer
   Dim iCol As Integer
   Dim iFld As Integer

   ' Library
   Dim rst_Lib As DAO.Recordset
   Dim sSQL_Lib As String
   Const LibStartRow As Byte = 4
   Const LibStartColumn As Byte = 4

   Dim rst_Pool As DAO.Recordset
   Dim sSQL_Pool As String
   Const PoolStartRow As Byte = 4
   Const PoolStartColumn As Byte = 5

   Dim rst_Media As DAO.Recordset
   Dim sSQL_Media As String
   Const MediaStartRow As Byte = 4
   Const MediaStartColumn As Byte = 3


   Const cTabTwo As Byte = 2
   Const cStartRow As Byte = 4
   Const cStartColumn As Byte = 3
   Dim FileName As String
   DoCmd.Hourglass True

   ' set to break on all errors
   Application.SetOption "Error Trapping", 0


'Stop


sSQL_CM = "select distinct CM from tCellManager"
ssql_cm_count = "select distinct count(CM) as CountCM from tCellManager"

Set rst_CM = CurrentDb.OpenRecordset(sSQL_CM, dbOpenSnapshot)
If Not rst_CM.BOF Then rst_CM.MoveFirst

Dim CMName, LibName, PoolName As String


CMName = rst_CM.Fields("CM")

'---------- create excel file using template and rename file to as CM name, file may lock during failure. Open others excel file and close the excel.
            sTemplate = CurrentProject.Path & "\MediaHandlingTemplate.xls"
            sOutput = CurrentProject.Path & "\" & CMName & ".xls"    'I have multiple Cell Manager. One Cell Manager create one file
            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)
'----------
        '
                Do While Not rst_CM.EOF
                    sSQL = "select distinct Library from qExportMedia where CM ='" & CMName & "'"

                    Set rst_Lib = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
                        
                        
                        Do While Not rst_Lib.EOF
                        'In cell manager have multiple Library. Print the library name into specify cell
                        LibName = rst_Lib.Fields("Library")

                            If LibName = "" Then

                               sSQL = "Select DISTINCT Pool from qExportMedia where CM ='" & CMName & "'"

                            Else
                               sSQL = "select DISTINCT Pool from qExportMedia where library = '" & LibName & "'"
                               PrintLib (rst_Lib)
                            End If
                            
                            Set rst_Pool = CurrentDb.OpenRecordset(sSQL, dbOpenSnapshot)
                            
                            Do While Not rst_Pool.EOF
                            PoolName = rst_Pool.Fields("Pool")
                                sSQL = "Select Label from qExportMedia where pool='" & PoolName & ""
                                PrintPool (rst_Pool)
                                
                            Loop
                            
                            
                            
                            rst_Lib.MoveNext
                        Loop
                        
                        wbk.SaveAs sOutput
                        wbk.Close sOutput
                        appExcel.Quit
                    rst_CM.MoveNext
                Loop
                


        ExportRequest = "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
wbk.SaveAs sOutput
wbk.Close sOutput
appExcel.Quit
Resume exit_Here

End Function

Private Function PrintLib()

Const LibStartRow As Byte = 4
Const LibStartColumn As Byte = 4
   
iCol = LibStartColumn
iRow = LibStartRow
iFld = 0
lRecords = lRecords + 1

    For iCol = iRow To iCol + (rst_Lib.Fields.count - 1)
            
        wks.Cells(iRow, iCol) = rst_Lib.Fields(iFld)
        
            If InStr(1, rst_Lib.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
End Function

Private Function PrintPool()
' Start with a clean file built from the template file
' For this template, the data must be placed on the 4th row, Fifth column.
' (these values are set to constants for easy future modifications)

   Const PoolStartRow As Byte = 4
   Const PoolStartColumn As Byte = 5

    iCol = PoolStartColumn
    iRow = PoolStartRow
    iFld = 0
    lRecords = lRecords + 1
        'Me.lblMsg.Caption = "Exporting record #" & lRecords & " to MediaHandling.xls"
        'Me.Repaint
            
            
           
            For iCol = PoolStartRow To PoolStartColumn + (rst_Pool.Fields.count - 1)
            
                wks.Cells(iRow, iCol) = rst_Lib.Fields(iFld)

                If InStr(1, rst_Pool.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

End Function

Private Function PrintMediaLabel()

' Start with a clean file built from the template file
' For this template, the data must be placed on the 4th row, third column.
' (these values are set to constants for easy future modifications)

Const MediaStartRow As Byte = 4
Const MediaStartColumn As Byte = 3
    iCol = MediaStartColumn
    iRow = MediaStartRow
    iFld = 0
    lRecords = lRecords + 1
        'Me.lblMsg.Caption = "Exporting record #" & lRecords & " to MediaHandling.xls"
        'Me.Repaint
        
            For iCol = MediaStartRow To MediaStartColumn + (rst_Media.Fields.count - 1)
            
                wks.Cells(iRow, iCol) = rst_Media.Fields(iFld)
                
                If InStr(1, rst_Media.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

End Function


MOD EDIT: When posting code...USE CODE TAGS!!!

:code:

This post has been edited by JackOfAllTrades: 19 October 2010 - 04:08 AM


Is This A Good Question/Topic? 0
  • +

Replies To: Export query data

#2 guyfromri  Icon User is offline

  • D.I.C Addict

Reputation: 46
  • View blog
  • Posts: 817
  • Joined: 16-September 09

Re: Export query data

Posted 19 October 2010 - 11:18 AM

I may be oversimplifying here and I haven't used this method with a query but I imagine it works the same.


docmd.TransferSpreadsheet acExport,,"QueryName","ExportFileName",false




Like I said, it may be wayy too simple for what you want to do but it's how I would get the info to excel then you can open the excel file as an object and do the work from there.


Hope that helps :)
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1