Results 1 to 6 of 6
  1. #1
    SidCharming is offline Novice
    Windows 10 Access 2016
    Join Date
    Apr 2018
    Location
    Minneapolis, MN
    Posts
    27

    Need help using SQL command to run query and populate into Excel

    I am writing VBA code that contains SQL code (with variables for filtering) that outputs a list of values that will be populated to the current Excel sheet starting at cell A9.

    I am uncertain how to take the output from the SQL code, which the number of rows can vary from 3 to 15 data points. The SQL is designed to output only one column. I am expecting the data to flow down from A9.

    The source of the VBA is within Access to output data to an Excel file which in the code I already have open and populating from form populated data.

  2. #2
    orange's Avatar
    orange is offline Moderator
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2009
    Location
    Ottawa, Ontario, Canada; West Palm Beach FL
    Posts
    16,716
    Perhaps you should show readers the vba and sql involved. It's difficult to answer when there is no data nor example.

  3. #3
    SidCharming is offline Novice
    Windows 10 Access 2016
    Join Date
    Apr 2018
    Location
    Minneapolis, MN
    Posts
    27
    The SQL (in raw format):

    Code:
    SELECT
      tblPractice.PracticeCode,
      tblProjectRole.ProjectRoleName,
      tblSkillType.SkillType,
      tblProjectTypes.ProjectName,
      tblQuestions.qNo,
      tblQuestions.Question
    FROM
      tblProjectTypes
      INNER JOIN (
        tblSkillType
        INNER JOIN (
          tblProjectRole
          INNER JOIN (
            tblPractice
            INNER JOIN tblQuestions ON tblPractice.aID = tblQuestions.PracticeID
          ) ON tblProjectRole.aID = tblQuestions.ProjectRoleID
        ) ON tblSkillType.aID = tblQuestions.SkillTypeID
      ) ON tblProjectTypes.aID = tblQuestions.ProjectTypeID
     
    WHERE
      tblPractice.PracticeNameType = "Employee Workforce"
      and tblProjectRole.ProjectRoleName = "Analyst"
      and tblProjectTypes.ProjectName = "Benefits"
      and tblSkillType.SkillType = "Hard"
     
     
    GROUP BY
      tblPractice.PracticeCode,
      tblProjectRole.ProjectRoleName,
      tblSkillType.SkillType,
      tblProjectTypes.ProjectName,
      tblQuestions.qNo,
      tblQuestions.Question
    ORDER BY
      tblPractice.PracticeCode,
      tblProjectRole.ProjectRoleName,
      tblSkillType.SkillType,
      tblProjectTypes.ProjectName,
      tblQuestions.qNo;
    below is a snippet from my VBA code I am working with.

    Code:
    Dim MyXL As ObjectDim TemplateDirectory, TemplateFile, CompiledDirectory As String
    CompiledDirectory = CompiledDirectory & AssociateArray(1, X) & ".xlsx"
    
    Set MyXL = CreateObject("Excel.Application")
    With MyXL
      .Application.Visible = True
      .workbooks.Open CompiledDirectory
    End With
    
    
    MyXL.activesheet.range("B5") = tmpPractice & " " & AssociateArray(o, X) & " Assessment Form"
    MyXL.activesheet.range("B7") = tmpPractice & " " & AssociateArray(o, X) & " Tasks"
    MyXL.activesheet.range("A8") = tmpProjectType
    MyXL.activesheet.range("A9") = "range"  'Populate RANGE A9:Ax from Query

  4. #4
    Gicu's Avatar
    Gicu is offline VIP
    Windows 8 Access 2013
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    4,101
    Have you looked at the CopyFromRecordset method ?
    https://analysistabs.com/vba-code/ra...fromrecordset/

    Cheers,
    Vlad

  5. #5
    SidCharming is offline Novice
    Windows 10 Access 2016
    Join Date
    Apr 2018
    Location
    Minneapolis, MN
    Posts
    27
    Quote Originally Posted by Gicu View Post
    Have you looked at the CopyFromRecordset method?
    https://analysistabs.com/vba-code/ra...fromrecordset/

    Cheers,
    Vlad
    Hi Vlad, I reviewed the given link and it appears to have something resembling SQL, but it is querying an Excel file. My objective is data exists within an Access Table and my SQL query pulls data from that table (tblQuestions) with a filter generated. The output then is populated into Excel.

    I could be mistaken and your intent is not at the SQL level of their example but below it in the (CopyFromRecordset)?

    Code:
    '=>Paste the data into a sheet 
    Sheet2.Range("A2").CopyFromRecordset rs
    If that is the case I haven't looked into it but if you say I can use Access SQL for building the rs record set... I'll work that in.

  6. #6
    Gicu's Avatar
    Gicu is offline VIP
    Windows 8 Access 2013
    Join Date
    Jul 2015
    Location
    Kelowna, BC, Canada
    Posts
    4,101
    Hi there,
    Yes, that is what I meant. Have a look at the code below (from my free utility http://forestbyte.com/ms-access-util...able-designer/) - it is the code behind the Excel Pivot Table button. Pay attention to the code in red:

    Code:
    Private Sub cmdExcelPivotTable_Click()
    On Error Resume Next
    Dim sExcelFile As String
    
    
    'Dim oApp As Object
    'Dim oPC As Object
    'Dim oPT As Object
    'Dim oWT As Object
    'Dim oWS As Object
    
    
    
    
    Dim oApp As Excel.Application
    Dim oPC As Excel.PivotCache
    Dim oPT As Excel.PivotTable
    Dim oWT As Excel.Workbook
    Dim oWS As Excel.Worksheet
    Dim oNm As Excel.Name
    
    
    
    
    Dim PivotCache As Object
    Dim PF As Object
    Dim PI As Object
    
    
    
    
    Dim lastRow As Long, lastColumn As Long
    Dim lStartOfDataList As Long
    Dim lEndOfDataList As Long
    Dim sColumns As String, sRows As String, sPages As String
    Dim sColumn() As String, sRow() As String, sPage() As String
    Dim sArrayColumns() As String, sArrayRows() As String, sArrayPages() As String
    Dim i As Integer, sPivotField As String
    
    
    Dim rs As Recordset, sNamedRange As String
    Dim vaTmp() As String
    Dim sSheet As String, sTL_Address As String, sBR_address As String
    Dim t, prm As DAO.Parameter, qdf As DAO.QueryDef, db As DAO.Database, X As Integer, lRecords As Long
    
    
    
    
    
    
    'first lets save the settings
    cmdSavePivotSettings_Click
    
    
    
    
    Application.Echo False
    
    
    sNamedRange = Nz(Me.tNamedRange, Replace(Replace(Replace(Replace(Replace(Replace(Me.txtPivotSource, " ", "_"), "-", "_"), ".", "_"), ",", "_"), ";", "_"), "\", "_"))
    
    
    If Me.grpPivotAction = 1 Then
    
    
    'create new Excelfile every time
    
    
                If IsNull(Me.tExcelFileName) Then
                    'sExcelFile = GetSaveFile(Me.txtPivotSource) '& ".xls")
                    sExcelFile = vcGetFileNameExcel(Me.txtPivotSource & ".xlsx")
                Else
                    sExcelFile = Me.tExcelFileName
                End If
                
                If sExcelFile = "" Then
                    Application.Echo True
                    Exit Sub
                End If
                
                'DoCmd.OutputTo acOutputQuery, Me.txtPivotSource, acFormatXLS, sExcelFile, True
                Kill sExcelFile 're-create new Excelfile every time
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, Me.txtPivotSource, sExcelFile, True, sNamedRange
                
                
                Set oApp = CreateObject("Excel.Application")
                
                With oApp
                          
                        On Error GoTo 0
                      .Visible = True
                      .Workbooks.Open sExcelFile
                    Set oWT = .ActiveWorkbook
                        Set oWS = oWT.ActiveSheet
                   
                        
                        .ScreenUpdating = False
                        .DisplayAlerts = False
                
                        'now to autofit columns
                        lStartOfDataList = 1
                        lastRow = oWS.Range("A" & oWS.Rows.Count).End(-4162).Row  'xlUp
                        lEndOfDataList = lastRow
                        lastColumn = oWS.Cells(lStartOfDataList, oWS.Columns.Count).End(-4159).Column   'xlToLeft
                    
                        oWS.Range(oWS.Cells(1, 1), oWS.Cells(lastRow, lastColumn)).Select
                        .Selection.WrapText = False
                        oWS.Range(oWS.Cells(1, 1), oWS.Cells(lastRow, lastColumn)).Columns.AutoFit
                        oWS.Range("A1").Select
                        oWS.Name = "ISP Pivot Table Data"
                        
                        'now lets move to Sheet 1 and create the pivot table to analyze
                        'Define input area and set up a Pivot Cache
                           '("A" & lStartOfDataList & ":F" & lEndOfDatList - 1))
                        oWT.Worksheets.Add(Before:=oWT.Worksheets(1)).Name = "ISP Pivot Table Analysis"
                        'Set oPC = oWT.PivotCaches.Add(SourceType:=1, _
                                SourceData:=oWS.Range(oWS.Cells(lStartOfDataList, 1), oWS.Cells(lEndOfDataList, lastColumn))) '1=xlDatabase
                        Set oPC = oWT.PivotCaches.Add(SourceType:=1, SourceData:=oWS.Range(sNamedRange)) '1=xlDatabase
                                            
                        Set oPT = oPC.CreatePivotTable(TableDestination:=oWT.Worksheets("ISP Pivot Table Analysis").Cells(7, 2), _
                                    TableName:="pvtISP")
                                                  
                        'fill the columns array
                        sColumns = ""
                        For i = 0 To 4
                            If Nz(Me.Controls("Column" & i + 1), "") <> "" Then sColumns = sColumns & "," & Me.Controls("Column" & i + 1)
                        Next i
                        sColumns = IIf(Left(sColumns, 1) = ",", Mid(sColumns, 2), sColumns)
                        If sColumns = "" Then GoTo PVT_ROW_ARRAY
                        sColumn = Split(sColumns, ",")
                        ReDim sArrayColumns(UBound(sColumn))
                        For i = 0 To UBound(sColumn)
                            sArrayColumns(i) = sColumn(i)
                        Next i
                        oPT.AddFields ColumnFields:=sArrayColumns, AddToTable:=True
    PVT_ROW_ARRAY:
                        'fill the rows array
                        sRows = ""
                        For i = 0 To 4
                            If Nz(Me.Controls("Row" & i + 1), "") <> "" Then sRows = sRows & "," & Me.Controls("Row" & i + 1)
                        Next i
                        sRows = IIf(Left(sRows, 1) = ",", Mid(sRows, 2), sRows)
                        If sRows = "" Then GoTo PVT_PAGE_ARRAY
                        sRow = Split(sRows, ",")
                        ReDim sArrayRows(UBound(sRow))
                        For i = 0 To UBound(sRow)
                            sArrayRows(i) = sRow(i)
                        Next i
                        oPT.AddFields RowFields:=sArrayRows, AddToTable:=True
    PVT_PAGE_ARRAY:
                '       'fill the Pages array
                        sPages = ""
                        For i = 0 To 2
                            If Nz(Me.Controls("Page" & i + 1), "") <> "" Then sPages = sPages & "," & Me.Controls("Page" & i + 1)
                        Next i
                        sPages = IIf(Left(sPages, 1) = ",", Mid(sPages, 2), sPages)
                        If sPages = "" Then GoTo PVT_ADD_DATA_FIELDS
                        sPage = Split(sPages, ",")
                        ReDim sArrayPages(UBound(sPage))
                        For i = 0 To UBound(sPage)
                            sArrayPages(i) = sPage(i)
                        Next i
                        oPT.AddFields PageFields:=sArrayPages, AddToTable:=True
                        
    PVT_ADD_DATA_FIELDS:
                        
                        'now lets add the data fields
                         For i = 0 To 4
                            If Nz(Me.Controls("Data" & i + 1), "") <> "" Then
                                sPivotField = Me.Controls("Data" & i + 1)
                                oPT.AddDataField oPT.PivotFields(sPivotField), Nz(Me.Controls("DATA_Caption" & i + 1), Me.Controls("DATA_Metric" & i + 1).Column(1) & " of " & sPivotField), CLng(Me.Controls("DATA_Metric" & i + 1))
                            End If
                        Next i
                        
                        'show details
                        If Me.grpDetails = 2 Then
                            With oWT.Worksheets("ISP Pivot Table Analysis").PivotTables(1).TableRange1
                                .Cells(.Rows.Count, .Columns.Count).ShowDetail = True
                            End With
                        
                        End If
                
                
                            
                            For Each PivotCache In oWT.PivotCaches
                                PivotCache.Refresh
                            Next
                         'lets do the header
                        oWT.Worksheets("ISP Pivot Table Analysis").Range("A1") = "Selected query:"
                        oWT.Worksheets("ISP Pivot Table Analysis").Range("A1").Font.Name = "Calibri"
                        oWT.Worksheets("ISP Pivot Table Analysis").Range("A1").Font.Size = 12
                        oWT.Worksheets("ISP Pivot Table Analysis").Range("A1").Font.Color = 16744448
                        oWT.Worksheets("ISP Pivot Table Analysis").Range("A2") = Me.txtPivotSource
                        
                        oWT.Worksheets("ISP Pivot Table Analysis").Select
                        
                        .ScreenUpdating = True
                        .DisplayAlerts = True
                   End With
     Else
        'use existing Excel template - export data and refresh pivot tables
       
        
        sExcelFile = Nz(Me.tExcelTemplate, "")
        If sExcelFile = "" Then
           MsgBox "The Excel file template is missing!", vbCritical, "No template selected"
           Me.tExcelTemplate.SetFocus
           Exit Sub
        End If
        
        If Dir(sExcelFile) = "" Then
           MsgBox "The Excel file template name/path is wrong!", vbCritical, "No template with selected name exists"
           Me.tExcelTemplate.SetFocus
           Exit Sub
        End If
       
       Set db = CurrentDb
       Set qdf = db.QueryDefs(Me.txtPivotSource)
    
       For Each prm In qdf.Parameters
        prm.Value = Eval(prm.Name)
       Next prm
    
        Set rs = qdf.OpenRecordset()
        ReDim vaTmp(rs.Fields.Count)
        For X = 0 To rs.Fields.Count - 1
            vaTmp(X) = rs.Fields(X).Name
        Next
    
           rs.MoveLast
           lRecords = rs.RecordCount
           rs.MoveFirst
    
                Set oApp = CreateObject("Excel.Application")
    
                With oApp
                    On Error GoTo 0
                    .Visible = True
                    .Workbooks.Open sExcelFile
                    Set oWT = .ActiveWorkbook
    
                        .ScreenUpdating = False
                        .DisplayAlerts = False
    
                       t = Me.tNamedRange
                       Set oNm = oWT.Names(t)
                       sSheet = Mid(oNm.RefersTo, 3, InStr(oNm.RefersTo, "!") - 4)
                       Set oWS = oWT.Worksheets(sSheet)
                       oWS.Range(t).Clear
    
                       oWS.Range(t).Cells(1, 1).Resize(1, rs.Fields.Count) = vaTmp
                       oWS.Range(t).Cells(2, 1).CopyFromRecordset rs
                       'need to resize the named range to be equal to the used range
                       lastRow = lRecords  '
                       lastColumn = X - 1 'x count started from 0
    '                   Dim y, w
    '                   y = oWS.Range(t).Cells(1, 1).Column + lastColumn
    '                   w = oWS.Range(t).Cells(1, 1).Row + lastRow
    '                   sBR_address = oWS.Cells(oWS.Range(t).Cells(1, 1).Column + lastColumn, oWS.Range(t).Cells(1, 1).Row + lastRow).Address
    '                   sTL_Address = oWS.Range(t).Cells(1, 1).Address
    '                   oWT.Names.Add t, RefersTo:="=" & sSheet & "!" & sTL_Address & ":" & sBR_address
                       
                       oWS.Range(oWS.Range(t).Cells(1, 1), oWS.Cells(oWS.Range(t).Cells(1, 1).Row + lastRow, oWS.Range(t).Cells(1, 1).Column + lastColumn)).Name = t
                       
                       
                    'refresh pivot table(s)
                    For Each PivotCache In oWT.PivotCaches
                        PivotCache.Refresh
                    Next
                       
                   oWT.Worksheets(1).Select
                   
                    Set rs = Nothing
                    Set prm = Nothing
                    Set qdf = Nothing
                    Set db = Nothing
                End With
     End If
     
    Application.Echo True
    oApp.ScreenUpdating = True
    oApp.DisplayAlerts = True
    oApp.Visible = True
    Set oApp = Nothing
    End Sub

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 3
    Last Post: 05-05-2016, 12:05 PM
  2. Replies: 25
    Last Post: 10-30-2013, 12:40 AM
  3. Command button to populate subform
    By akhlaq768 in forum Forms
    Replies: 2
    Last Post: 02-07-2012, 04:57 AM
  4. Replies: 3
    Last Post: 10-17-2011, 01:13 PM
  5. Populate text boxes with a command button
    By Brian62 in forum Forms
    Replies: 3
    Last Post: 09-30-2011, 12:52 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums