copying query into excel object range

[mrbg07546]

Hi,

I have a excel object I have opened, and want to copy a query into a named range on the workbook.

any idea how? heres the start have made

Sub openExcel()

'WillR - opens the specified Spreadsheet
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Set xlApp = New Excel.Application
With xlApp
.Visible = True
Set xlWB = .Workbooks.Open(CurrentProject.Path & "\" & workBookName, , False)

''' xlWB.Range("NPVINPUT") = myquery

End With
End Sub

 

[pr2-eugin]

Try something like this..

Sub openExcel()
    [COLOR=Green]'WillR - opens the specified Spreadsheet[/COLOR]
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    [B][COLOR=Blue]Dim tmpRS As DAO.Recordset
    
    Set tmpRS = CurrentDB.OpenRecordset("myquery")[/COLOR][/B]
    Set xlApp = New Excel.Application
    With xlApp
        .Visible = True
        Set xlWB = .Workbooks.Open(CurrentProject.Path & "\" & workBookName, , False)
        xlWB.Range("NPVINPUT")[B][COLOR=Blue].CopyFromRecordset tmpRs[/COLOR][/B]
    End With
End Sub

 

[mdlueck]

A post I refer to for driving Excel from Access:

How to drive Excel with VBA (Access) in order to transfer values into spreadsheet
http://www.access-programmers.co.uk/forums/showthread.php?t=233104#post1190025


And I have an ADO.Recordset working from Access to Excel:

Public Sub PopulateWorkbook()
On Error GoTo Err_PopulateWorkbook

  [B][COLOR=Blue]Dim adoRS As Object[/COLOR][/B]
  Dim strCellName As String
  Dim strSQL As String

  'Log the current operation to the StatusBar
  Call SysCmd(acSysCmdSetStatus, "Populating Workbook with Collected Data, Please Wait...")
  DoEvents

  'Workbook Header
  strCellName = "C1"
  objExcelWks.Range(strCellName).Select

  'Select the correct string to label this report with
  Select Case Me.runmode
    Case "PROJ"
      objExcelApp.ActiveCell.FormulaR1C1 = ObjProjectsTbl.title
    Case "PROD"
      objExcelApp.ActiveCell.FormulaR1C1 = ObjProjectsTbl.title & " \ " & ObjProductsTbl.title
    Case Else
      GoTo Err_PopulateWorkbook
  End Select

  'Define a query to harvest from the FE Temp Table and publish to the spreadsheet file
  strSQL = "SELECT [t].[partnumber],[t].[parttitle],[t].[partvendortitle],[t].[toolstatustitle],[t].[lttotal],[t].[toolduedate],[t].[besttoolcost],[t].[prodpartflg]" & vbCrLf & _
           "FROM [" & Me.FETempTableName & "] AS [t]" & vbCrLf & _
           "ORDER BY [t].[partnumber], [t].[toolduedate] DESC;"

[B][COLOR=Blue]  'Define attachment to database table specifics and execute commands via With block
  Set adoRS = CreateObject("ADODB.Recordset")
  With adoRS
    .ActiveConnection = CurrentProject.Connection
    .CursorType = adOpenDynamic
    .LockType = adLockOptimistic
    .Open strSQL
  End With[/COLOR][/B]

  'Copy the recordset into the worksheet
  strCellName = "B4"
  objExcelWks.Range(strCellName).CopyFromRecordset [B][COLOR=Blue]adoRS[/COLOR][/B]

  'Select the columns which data was transfered into
  objExcelApp.ActiveSheet.Cells.Select

  'Auto-fit the column widths
  objExcelApp.ActiveSheet.Cells.EntireColumn.AutoFit

  'Leave the selected cell as the top/left
  objExcelWks.Range("A1").Select

Exit_PopulateWorkbook:
  [B][COLOR=Blue]adoRS.Close
  Set adoRS = Nothing[/COLOR][/B]

  Exit Sub

Err_PopulateWorkbook:
  Call errorhandler_MsgBox("Class: " & TypeName(Me) & ", Subroutine: PopulateWorkbook()")
  'Disable further error handling, so that the code which is using this object will handle the error
  On Error GoTo 0
  'Raise the error to the caller program
  Err.Raise Number:=vbObjectError + 1073, _
            Source:="Class: " & TypeName(Me) & ", Subroutine: PopulateWorkbook()", _
            Description:="Failed to PopulateWorkbook()"
  Resume Exit_PopulateWorkbook

End Sub