Send Query Results to Array 1

[MacroAlan]

It seemed easy enough when I was writing the proposal.

Open a query and spill the results and field names to an Array. Then open Excel and write the results to specific “named fields” that have the same name as the Array field names.

Anybody got any code that would get me started? I stole the following from my predecessor.

    Call SetKeyValue("ReviewID", Me.investment_review_ID.Value)
    
    Set rstObj = CurrentDb.OpenRecordset("qryInvestReviewExport")
    ' Gets data from qryInvestReviewExport in anticipation of writing to  Review xlsx
    If (Not rstObj.EOF) Then
        For Each rstFld In rstObj.Fields
            If (Not IsNull(rstFld.Value)) Then [COLOR=red]'blows up here[/color]
                Set formSQLitem = formSQLdata.Item(rstFld.name)
                Let formSQLitem.formValue = rstFld.Value
            End If
            Debug.Print rstFld.name & Chr(32) & rstFld.Value    '06/23
        Next rstFld
        Call rstObj.MoveNext
    End If
    Call rstObj.Close
    Set rstObj = Nothing

Thanks!


Alan

 

[PWise]

this should do it

Function FillExcelSheet(Rst As Recordset)
Dim exCellApp As Excel.Application
Dim iCols As Integer
Dim FileName As String
Set exCellApp = CreateObject("Excel.Application")
With exCellApp
    .Workbooks.Add
    For iCols = 0 To Rst.Fields.Count - 1
        .Worksheets(1).Cells(1, iCols + 1).Value = Rst.Fields(iCols).Name
    Next
    With .Worksheets(1).Range("a2")
        .Select
        .CopyFromRecordset Rst
    End With
    .ActiveWindow.FreezePanes = True
    .Cells.Select
    .Cells.EntireColumn.AutoFit

FileName = SelectAFile("Excell Sheets", "*.Xls", "\\Server\DATA\Bright Smile Center\", 2)
If Nz(FileName, "") = "" Then
    MsgBox "You Pressed Cancel" & vbCrLf & "File will not Be saved!", vbCritical, CurrentProject.Properties("Apptitle")
    .ActiveWorkbook.Close (0)
    .Quit
    Exit Function
End If
If Dir(FileName & IIf(Right(FileName, 4) = ".xls", "", ".xls")) > "" Then
    Kill FileName & IIf(Right(FileName, 4) = ".xls", "", ".xls")
End If
.ActiveWorkbook.SaveAs FileName & IIf(Right(FileName, 4) = ".xls", "", ".xls")
.ActiveWorkbook.Saved = True
.Quit
End With
End Function
Function SelectAFile(FileType As String, FileFilter As String, InitialFileNameDir As String, MsoFileDialogType As Integer) As String
Dim dlgSaveAs As FileDialog
Dim vrtSelectedItem As Variant
Dim a As Integer
Set dlgSaveAs = Application.FileDialog(MsoFileDialogType)
With dlgSaveAs
    .ButtonName = "Save File Path"
    If MsoFileDialogType <> 2 Then
    For a = 1 To .Filters.Count
        .Filters.Delete (a)
    Next
    
    .Filters.Add FileType, FileFilter
    End If
    .InitialFileName = InitialFileNameDir
    .AllowMultiSelect = False
    .Show
    
    For Each vrtSelectedItem In .SelectedItems
      SelectAFile = vrtSelectedItem
      
Next
End With
End Function

 

[MacroAlan]

No, no, no!

I have an Excel template with named cells. I want to put the data from the Access query into those cells. The cells are named the same as the fields in Access.

I think I need to pass Excel the field name as well as the data.

The client has a report format in mind that will be sent to outside people to get updates that I will eventually import back in.

Clear as mud?


Alan

 

[PWise]

this line is the key

.CopyFromRecordset Rst

if your fields names are
name ,address ,city ,state ,zip

and the fields names are in row 1 in excell

this will paste the date in row 2
With .Worksheets(1).Range("a2")
.Select
.CopyFromRecordset Rst
End With