Selecting into Table and Exporting to Excell

**dccjr** · 04-05-2013, 06:10 PM

I am trying to query a table, store the result in a temp table, then export the temp to an Excel spreadsheet for the purpose of graphing. I can compile the complete program with no errors, but when I open the temp table it is empty, as is the worksheet in Excel. Here are the procedures being used, but with no error, I don't even know where to start.

Code:

Private Sub cboConstraint_AfterUpdate()
Dim strTrendSQL As String
Dim strParetoSQL As String
Dim strConEventReportSQL As String
Dim strConEventSummarySQL As String
strParetoSQL = ""
strConEventReportSQL = ""
strConEventSummarySQL = ""
Me.cboConValue.RowSource = ""
If Me.cboConstraint.Value = "Specific Date to Present" Then
    Me.fraConValue.Visible = False
    Me.cboConValue.Visible = False
    Me.txtDate.Visible = True
    Me.fraDate.Visible = True
Else
    Me.fraConValue.Visible = True
    Me.cboConValue.Visible = True
    Me.txtDate.Visible = False
    Me.fraDate.Visible = False
End If
Select Case Me.fraReport.Value
    Case 1
        Select Case Me.cboConstraint.Value
            Case "Work Order #"
                strConEventReportSQL = "SELECT RCAData1.WorkOrderNo, RCAData1.QualityNo FROM RCAData1 WHERE WorkOrderNo IS NOT NULL ORDER BY RCAData1.DefectDate;"
                Me.cboConValue.RowSource = strConEventReportSQL
                Me.cboConValue.Requery
            Case "Quality #"
                strConEventReportSQL = "SELECT RCAData1.QualityNo, RCADAta1.WorkOrderNo FROM RCAdata1 WHERE (QualityNo IS NOT NULL) ORDER BY RCAData1.DefectDate;"
                Me.cboConValue.RowSource = strConEventReportSQL
                Me.cboConValue.Requery
        End Select
    Case 2
        Select Case Me.cboConstraint.Value
            Case "Event Type"
                strConEventSummarySQL = "SELECT DISTINCT RCAData1.Type FROM RCAData1;"
                Me.cboConValue.ColumnCount = 1
                Me.cboConValue.RowSource = strConEventSummarySQL
                Me.cboConValue.Requery
            Case "Event Category"
                strConEventSummarySQL = "SELECT DISTINCT RCAData1.Category FROM RCAData1;"
                Me.cboConValue.ColumnCount = 1
                Me.cboConValue.RowSource = strConEventSummarySQL
                Me.cboConValue.Requery
            Case "Work Area/Cell"
                strConEventSummarySQL = "SELECT DISTINCT RCAData1.AreaCell FROM RCAData1;"
                Me.cboConValue.ColumnCount = 1
                Me.cboConValue.RowSource = strConEventSummarySQL
                Me.cboConValue.Requery
        End Select
    Case 3
        Call ExportRecordsetToExcel
    Case 4
        Call ExportRecordsetToExcel
    End Select
End Sub

The above Cases 3 and 4 are suppose to utilize the export function below.

Code:

Sub ExportRecordsetToExcel()
Dim strParetoSQL As String
Dim strTrendSQL As String
strParetoSQL = ""
strTrendSQL = ""
Select Case Me.fraReport.Value
    Case 3
        DoCmd.SetWarnings False
        DoCmd.RunSQL ("DELETE ChartTable.* FROM ChartTable")
        Call ClearParetoData
        Select Case Me.cboConstraint.Value
            Case "Specific Date to Present"
                strParetoSQL = "SELECT COUNT(*) INTO ChartTable FROM RCAData1 WHERE '" & Me.txtDate & "' < DefectDate GROUP BY month(DefectDate);"
            Case "Work Area/Cell"
                strParetoSQL = "INSERT INTO ChartTable (Field1, Field2, Field3, Field4) SELECT COUNT (*) FROM RCAData1 GROUP BY AreaCell;"
            Case "Event Type"
                strParetoSQL = "SELECT COUNT (*) INTO ChartTAble FROM RCAData1 GROUP BY Type;"
            Case "Event Category"
                strParetoSQL = "SELECT COUNT (*) INTO ChartTable FROM RCAData1 GROUP BY Category"
        End Select
        DoCmd.SetWarnings True
        DoCmd.RunSQL (strParetoSQL)
        Call SendParetoData
    Case 4
        DoCmd.SetWarnings False
        DoCmd.RunSQL ("DELETE ChartTable.* FROM ChartTable")
        Call ClearTrendData
        Select Case Me.cboConstraint.Value
            Case "6 Month Trend"
                strTrendSQL = "SELECT COUNT(*) INTO ChartTable FROM RCAData1 WHERE DefectDate > dateadd(mm,-6,getdate());"
            Case "12 Month Trend"
                strTrendSQL = "SELECT COUNT(*) INTO ChartTable FROM RCAData1 WHERE DefectDate > dateadd(mm,-12,getdate());"
            Case "24 Month Trend"
                strTrendSQL = "SELECT COUNT(*) INTO ChartTable FROM RCAData1 WHERE DefectDate > dateadd(mm,-24,getdate());"
        End Select
        DoCmd.SetWarnings True
        DoCmd.RunSQL (strTrendSQL)
        Call SendTrendData
    End Select
End Sub

Can someone tell me where the data is going, if anywhere?

**June7** · 04-05-2013, 06:25 PM

I fixed your post for code reabability. End tags have a forward slash at the beginning, like [/code].

Have you step debugged? Follow the code as executes. Are variables populated correctly? Identify where code deviates from expected behavior, fix, test again. See link at bottom of my post for debugging techniques.

Right off, I see not using # delimiters for date criteria - assuming DefectDate is a date/time type field, however, would think that would throw a run-time error:

WHERE #" & Me.txtDate & "# < DefectDate

and maybe

WHERE DefectDate >#dateadd(mm,-6,getdate())#;"

**dccjr** · 04-05-2013, 07:13 PM

OK. really shameful question coming, I can't step into the sub for some reason. I read the link you referred to, but it does not do anything. When I click Run, I am not given the option for the procedures. Just the procedure in a module called Public. Should I have created all of this in modules, and not in the form itself?

**dccjr** · 04-05-2013, 08:19 PM

I have decided to all of the code for this form, in hopes that someone will have some insight

Code:

Option Explicit
Option Compare Database
Private Sub Form_Load()
    Me.fraDate.Visible = False
    Me.txtDate.Visible = False
End Sub

Private Sub fraReport_AfterUpdate()
Me.cboConstraint.RowSource = ""
Select Case Me.fraReport.Value
    Case 1
        Me.cboConstraint.AddItem "Work Order #"
        Me.cboConstraint.AddItem "Quality #"
    Case 2
        Me.cboConstraint.AddItem "Event Type"
        Me.cboConstraint.AddItem "Event Category"
        Me.cboConstraint.AddItem "Work Area/Cell"
   Case 3
        Me.cboConstraint.AddItem "Specific Date to Present"
        Me.cboConstraint.AddItem "Work Area/Cell"
        Me.cboConstraint.AddItem "Event Type"
        Me.cboConstraint.AddItem "Event Category"
   Case 4
        Me.cboConstraint.AddItem "6 Month Trend"
        Me.cboConstraint.AddItem "12 Month Trend"
        Me.cboConstraint.AddItem "24 Month Trend"
        Me.fraConValue.Visible = False
        Me.cboConValue.Visible = False
    End Select
    Me.cboConstraint.Value = ""
End Sub

Private Sub cboConstraint_AfterUpdate()
Dim strTrendSQL As String
Dim strParetoSQL As String
Dim strConEventReportSQL As String
Dim strConEventSummarySQL As String
strParetoSQL = ""
strConEventReportSQL = ""
strConEventSummarySQL = ""
Me.cboConValue.RowSource = ""
    If Me.cboConstraint.Value = "Specific Date to Present" Then
        Me.fraConValue.Visible = False
        Me.cboConValue.Visible = False
        Me.txtDate.Visible = True
        Me.fraDate.Visible = True
    Else
        Me.fraConValue.Visible = True
        Me.cboConValue.Visible = True
        Me.txtDate.Visible = False
        Me.fraDate.Visible = False
    End If
    Select Case Me.fraReport.Value
        Case 1
            Select Case Me.cboConstraint.Value
                Case "Work Order #"
                    strConEventReportSQL = "SELECT RCAData1.WorkOrderNo, RCAData1.QualityNo FROM RCAData1 WHERE WorkOrderNo IS NOT NULL ORDER BY RCAData1.DefectDate;"
                    Me.cboConValue.RowSource = strConEventReportSQL
                    Me.cboConValue.Requery
                Case "Quality #"
                    strConEventReportSQL = "SELECT RCAData1.QualityNo, RCADAta1.WorkOrderNo FROM RCAdata1 WHERE (QualityNo IS NOT NULL) ORDER BY RCAData1.DefectDate;"
                    Me.cboConValue.RowSource = strConEventReportSQL
                    Me.cboConValue.Requery
            End Select
        Case 2
            Select Case Me.cboConstraint.Value
                Case "Event Type"
                    strConEventSummarySQL = "SELECT DISTINCT RCAData1.Type FROM RCAData1;"
                    Me.cboConValue.ColumnCount = 1
                    Me.cboConValue.RowSource = strConEventSummarySQL
                    Me.cboConValue.Requery
                Case "Event Category"
                    strConEventSummarySQL = "SELECT DISTINCT RCAData1.Category FROM RCAData1;"
                    Me.cboConValue.ColumnCount = 1
                    Me.cboConValue.RowSource = strConEventSummarySQL
                    Me.cboConValue.Requery
                Case "Work Area/Cell"
                    strConEventSummarySQL = "SELECT DISTINCT RCAData1.AreaCell FROM RCAData1;"
                    Me.cboConValue.ColumnCount = 1
                    Me.cboConValue.RowSource = strConEventSummarySQL
                    Me.cboConValue.Requery
            End Select
        Case 3
            Call ExportRecordsetToExcel
        Case 4
            Call ExportRecordsetToExcel
    End Select
End Sub

Public Sub cboConValue_AfterUpdate()
Dim strEventReportSQL As String
Dim strEventSummarySQL As String
Select Case Me.fraReport.Value
    Case 1
        Select Case Me.cboConstraint.Value
            Case 1
                strEventReportSQL = "SELECT * FROM RCAData1 WHERE RCAData.WorkOrderNo = '" & Me.cboConValue.Value & "';"
            Case 2
                strEventReportSQL = "SELECT * FROM RCAData1 WHERE RCAData1.QualityNo = '" & Me.cboConValue.Value & "';"
        End Select
    Case 2
        Select Case Me.cboConstraint.Value
            Case 1
                strEventSummarySQL = "SELECT * FROM RCAData1 WHERE RCAData1.Type = '" & Me.cboConValue.Value & "';"
            Case 2
                strEventSummarySQL = "SELECT * FROM RCAData1 WHERE RCAData1.Category = '" & Me.cboConValue.Value & "';"
            Case 3
                strEventSummarySQL = "SELECT * FROM RCAData1 WHERE RCAData1.AreaCell = '" & Me.cboConValue.Value & "';"
        End Select
End Select
End Sub

Public Sub cmdRptPrint_Click()
On Error Resume Next
Select Case Me.fraConValue.Value
    Case 1
        DoCmd.OpenReport "RCAEventReport", acViewReport, strEventReportSQL
        DoCmd.Close acForm, Me.Name, acSaveNo
        DoCmd.SelectObject acReport, "RCAEventReport"
        DoCmd.RunCommand acCmdPrint
        If Err.Number <> 0 And Err.Number <> 2501 Then
            MsgBox Err.Number & ":" & Err.Description, vbCritical
        End If
    Case 2
        DoCmd.OpenReport "RCASummaryReport", acViewReport, strEventSummarySQL
        DoCmd.Close acForm, Me.Name, acSaveNo
        DoCmd.SelectObject acReport, "RCASummaryReport"
        DoCmd.RunCommand acCmdPrint
        If Err.Number <> 0 And Err.Number <> 2501 Then
            MsgBox Err.Number & ":" & Err.Description, vbCritical
        End If
    Case 3
        DoCmd.OpenReport "ParetoChart", acViewReport
        DoCmd.Close acForm, Me.Name, acSaveNo
        DoCmd.SelectObject acReport, "objSummaryChart"
        DoCmd.RunCommand acCmdPrint
        If Err.Number <> 0 And Err.Number <> 2501 Then
            MsgBox Err.Number & ":" & Err.Description, vbCritical
        End If
    Case 4
        DoCmd.OpenReport "ParetoChart", acViewReport
        DoCmd.Close acForm, Me.Name, acSaveNo
        DoCmd.SelectObject acReport, "objSummaryChart"
        DoCmd.RunCommand acCmdPrint
        If Err.Number <> 0 And Err.Number <> 2501 Then
            MsgBox Err.Number & ":" & Err.Description, vbCritical
        End If
End Select
End Sub

Private Sub cmdRptPreview_Click()
    Select Case Me.fraConValue.Value
        Case 1
            DoCmd.OpenReport "RCAEventReport", acViewPreview, strEventReportSQL
            DoCmd.Close acForm, Me.Name, acSaveNo
        Case 2
            DoCmd.OpenReport "RCASummaryReport", acViewPreview, strEventSummarySQL
            DoCmd.Close acForm, Me.Name, acSaveNo
        Case 3
            DoCmd.OpenReport "Pareto Chart", acViewPreview
            DoCmd.Close acForm, Me.Name, acSaveNo
        Case 4
            DoCmd.OpenReport "TrendChart", acViewPreview
            DoCmd.Close acForm, Me.Name, acSaveNo
    End Select
End Sub

'Export Pareto or Trend data to Excel for Charting
Sub ExportRecordsetToExcel()
Dim strParetoSQL As String
Dim strTrendSQL As String
strParetoSQL = ""
strTrendSQL = ""
Select Case Me.fraReport.Value
    Case 3
        DoCmd.SetWarnings False
        DoCmd.RunSQL ("DELETE ChartTable.* FROM ChartTable")
        Call ClearParetoData
        Select Case Me.cboConstraint.Value
            Case "Specific Date to Present"
                strParetoSQL = "SELECT COUNT(*) INTO ChartTable FROM RCAData1 WHERE '" & Me.txtDate & "' < DefectDate GROUP BY month(DefectDate);"
            Case "Work Area/Cell"
                strParetoSQL = "INSERT INTO ChartTable (Field1, Field2, Field3, Field4) SELECT COUNT (*) FROM RCAData1 GROUP BY AreaCell;"
            Case "Event Type"
                strParetoSQL = "SELECT COUNT (*) INTO ChartTAble FROM RCAData1 GROUP BY Type;"
            Case "Event Category"
                strParetoSQL = "SELECT COUNT (*) INTO ChartTable FROM RCAData1 GROUP BY Category"
        End Select
        DoCmd.SetWarnings True
        DoCmd.RunSQL (strParetoSQL)
        Call SendParetoData
    Case 4
        DoCmd.SetWarnings False
        DoCmd.RunSQL ("DELETE ChartTable.* FROM ChartTable")
        Call ClearTrendData
        Select Case Me.cboConstraint.Value
            Case "6 Month Trend"
                strTrendSQL = "SELECT COUNT(*) INTO ChartTable FROM RCAData1 WHERE DefectDate > dateadd(mm,-6,getdate());"
            Case "12 Month Trend"
                strTrendSQL = "SELECT COUNT(*) INTO ChartTable FROM RCAData1 WHERE DefectDate > dateadd(mm,-12,getdate());"
            Case "24 Month Trend"
                strTrendSQL = "SELECT COUNT(*) INTO ChartTable FROM RCAData1 WHERE DefectDate > dateadd(mm,-24,getdate());"
        End Select
        DoCmd.SetWarnings True
        DoCmd.RunSQL (strTrendSQL)
        Call SendTrendData
End Select
End Sub

'Clears the pareto data worksheet in Excel
Function ClearParetoData()
Dim oXL As Object
Dim oBook As Object
Dim oSheet As Object
Set oXL = CreateObject("Excel.Application")
On Error Resume Next
oXL.UserControl = True
On Error GoTo 0
On Error GoTo ErrHandle
Set oBook = oXL.Workbooks.Open("E:\RCADatabase(FE)\RCACharting.xls")
Set oSheet = oBook.ParetoData
oSheet.Range("A1:E50").Select
oXL.Selection.ClearContents
oBook.Save
ErrExit:
       oBook.Close
       oXL.Application.Quit
       Set oXL = Nothing
       Set oBook = Nothing
       Set oSheet = Nothing
       Exit Function
ErrHandle:
      oXL.Visible = False
      MsgBox Err.Description
      GoTo ErrExit
End Function

'Clears the trend dataworksheet in Excel
Function ClearTrendData()
Dim oXL As Object
Dim oBook As Object
Dim oSheet As Object
Set oXL = CreateObject("Excel.Application")
On Error Resume Next
oXL.UserControl = True
On Error GoTo 0
On Error GoTo ErrHandle
Set oBook = oXL.Workbooks.Open("E:\RCADatabase(FE)\RCACharting.xls")
Set oSheet = oBook.TrendData
oSheet.Range("A1:E50").Select
oXL.Selection.ClearContents
oBook.Save
ErrExit:
       oBook.Close
       oXL.Application.Quit
       Set oXL = Nothing
       Set oBook = Nothing
       Set oSheet = Nothing
       Exit Function
ErrHandle:
      oXL.Visible = False
      MsgBox Err.Description
      GoTo ErrExit
End Function

Public Function SendParetoData()
    ' strTQName is the name of the table or query you want to send to Excel
    ' strSheetName is the name of the sheet you want to send it to
       Dim rst As DAO.Recordset
       Dim ApXL As Object
       Dim xlWBk As Object
       Dim xlWSh As Object
       Dim fld As DAO.Field
       Dim strPath As String
       Const xlCenter As Long = -4108
       Const xlBottom As Long = -4107
       strPath = "E:\RCADatabase(FE)\RCACharting.xls"
    On Error GoTo err_handler
   
    Set rst = CurrentDb.OpenRecordset("ChartTable")
    Set ApXL = CreateObject("Excel.Application")
        Set xlWBk = ApXL.Workbooks.Open(strPath)
        ApXL.Visible = True
        Set xlWSh = xlWBk.Worksheets("ParetoData")
        xlWSh.Activate
        xlWSh.Range("A1").Select
        For Each fld In rst.Fields
            ApXL.ActiveCell = fld.Name
            ApXL.ActiveCell.Offset(0, 1).Select
        Next
        rst.MoveFirst
        xlWSh.Range("A2").CopyFromRecordset rst
        xlWSh.Range("1:1").Select
    rst.Close
    Set rst = Nothing
    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
End Function

Public Function SendTrendData()
        ' strTQName is the name of the table or query you want to send to Excel
        ' strSheetName is the name of the sheet you want to send it to
           Dim rst As DAO.Recordset
           Dim ApXL As Object
           Dim xlWBk As Object
           Dim xlWSh As Object
           Dim fld As DAO.Field
           Dim strPath As String
           Const xlCenter As Long = -4108
           Const xlBottom As Long = -4107
        On Error GoTo err_handler
        strPath = "E:\RCADatabase(FE)\RCACharting.xls"
        Set rst = CurrentDb.OpenRecordset("ChartTable")
        Set ApXL = CreateObject("Excel.Application")
            Set xlWBk = ApXL.Workbooks.Open(strPath)
            ApXL.Visible = True
            Set xlWSh = xlWBk.Worksheets("TrendData")
            xlWSh.Activate
            xlWSh.Range("A1").Select
            For Each fld In rst.Fields
                ApXL.ActiveCell = fld.Name
                ApXL.ActiveCell.Offset(0, 1).Select
            Next
            rst.MoveFirst
            xlWSh.Range("A2").CopyFromRecordset rst
            xlWSh.Range("1:1").Select
        rst.Close
        Set rst = Nothing
        Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function
End Function

**June7** · 04-05-2013, 09:01 PM

The menu Run will only work with public code in general modules and macros.

The way I debug code behind form is to set breakpoint(s) then interact with the form normally (button click, data entry/edit, etc) and follow the code execution. When it hits the breakpoint it stops and I can then step through the code with F8.

Did you fix date delimiters?

Something I would not do is use the # character in criteria string, as in: "Work Order #" and "Quality #"

**dccjr** · 04-08-2013, 03:58 PM

Delimiters fixed. I am stepping through (thanks for the directions on using that), and I am getting the error:

"Object does not support this property or method." on the following line.

DoCmd.RunSQL strParetoSQL

This is actually the line highlighted. The previous line is:

DoCmd.SetWarnings True

Not sure what I have done wrong.

**dccjr** · 04-08-2013, 04:04 PM

Also, I am not getting an error on my Me.cboConValue.Requery, but it doesn't seem to be doing anything. Does this have to be used with DoCmd?

Correction to the previous post, I am getting a Runtime Error 3000 on the DoCmd.RunSQL strParetoSQL line.

"Reserved error (-3201); there is no message for this error."

**June7** · 04-08-2013, 04:07 PM

Which SQL is the code trying to run? RunSQL is only for action SQL (INSERT, UPDATE, DELETE). I just tested it with SELECT INTO and works. Don't know why it doesn't like your SQL, I can't see anything wrong with them.

I prefer CurrentDb.Execute instead of DoCmd.RunSQL because don't need the SetWarnings lines. However, will probably have same issue with the SQL.

The combobox requery is correct as is.

**dccjr** · 04-08-2013, 04:52 PM

I am trying to run a SELECT COUNT query. I just tried the Curreddb.Execute instead of the DoCmd. I still get the "Object does not support this property or method." error. This is in the ExportRecordsetToExcel procedure for Case 4.

**June7** · 04-08-2013, 05:23 PM

Maybe date delimiters are needed:

> #dateadd(mm,-6,getdate())#;"

**dccjr** · 04-08-2013, 05:30 PM

I have added them. Same problem. Is this SELECT COUNT statement correct?

SELECT COUNT(*) INTO ChartTable FROM RCAData1 WHERE DefectDate > #dateadd(mm,-6,getdate())#;

I have never used one, and could not find a similar example online, so I had to piece it together. That is the only thing that comes to mind is that I am using the wrong (or incorrectly using the correct) SQL.

This statement should be counting all of the records from the present date back, and grouping them by month.

Also, now using the Currentdb.Execute, I can remove the SetWarnings lines?

**June7** · 04-09-2013, 09:20 AM

I tested a SELECT COUNT(*) INTO and it worked for me, no errors. Creates a new table. I tested by type into and executing from the Immediate Window.

I cannot see any thing else. Would have to work with project.

Yes, no need for SetWarnings when use CurrentDb.Execute.

**dccjr** · 04-09-2013, 05:39 PM

Do I need to use the GROUP BY operator in order to have it breakdown the count by month? If so, how do I group by month from a time/date field?
If you would like to see the entire project, I can attach it (I would have to either clear a dummy BE or not send the BE at all).

**June7** · 04-10-2013, 01:17 PM

Create a field with expression to extract the month from the date with: Month(DefectDate)

Use that as the GROUP BY field.

**dccjr** · 04-10-2013, 10:40 PM

Finally figured it out! Below is the solution, as I used them in a couple of places.

Code:

SELECT Format(DefectDate,'mmmm') as Month, Count(DefectDate) as cnt FROM RCAData1 GROUP BY Format(DefectDate,'mmmm'), ORDER BY Format(DefectDate,'mm');

---- OR ----

SELECT Format(DefectDate,'m')as mth , COUNT(*)as cnt FROM RCAData1 WHERE Format(DefectDate,'m') >= DateAdd('m', -6, currentdate) GROUP BY Format(DefectDate,'m') ;

Took a little experimenting and some searching, but it works!!!! Thanks June7

Selecting into Table and Exporting to Excell

Thread Tools

Selecting into Table and Exporting to Excell

Similar Threads

Exporting to excell help

Exporting Pivot Table to Excell - only want filtered records

Selecting row sections from a table

query- selecting a table...

Selecting the last value of the table and show

Posting Permissions