VBA Auto putting Access data into Excel

[Paul_birm]

Hi all

what I need to do is have a form that inputs a series of answers to questions and then save the data to a table and then summarize the data into an excel spreadsheet.

i have got the form, inputs, Vba for the update of the table and the command to open a new or existing excel spreadsheet, but what i am missing is how i get the data from my table into the spreadsheet when the vba Updates the table automatically.

the write to the access table is done on a "submit" button, I want to add the automation of i) opening excel and ii) downloading the data into excel
from within the button event

i am running Access 2003 and Excel 2003 on Win xp (if that helps anyone).

 

[Rabbie]

You should be able to add the code to rwrite the data to the Excel spreadsheet in the OnClick event for your button. You will need to have code to read the data from your table.

 

[Paul_birm]

Rabbie

thanks for that.

I am aware that the OnClick event would be the event to use, However, i dont have enough VB skills to write the code (syntax wise)....

I think what i am looking for is help with the vb syntax or a code example to 'clone' for my requirements.

Paul

 

[chergh]

Add excel references and use the following code to copy your data from your table to excel.

dim xlapp as excel.application
dim wb as excel.workbook
dim ws as excel.worksheet

dim rs as recordset

set xlapp = new excel.application
set wb = xlapp.workbooks.add
set ws = wb.worksheets("Sheet1")

set rs = currentdb.openrecordset("TableName")

ws.range("A1").copyfromrecordset rs

set rs = nothing
set ws = nothing
set wb = nothing
set xlapp = nothing

 

[Rabbie]

You would need to give more information about what you are actually doing so we can help you. As a starter here is some code that writes out to an Excel spreadsheet

Sub SampleSub(TeamManager As String, MonthName As String)
Dim recData As DAO.Recordset, rst As DAO.Recordset
Dim dbs As Database, StartDate As Date, EndDate As Date
Dim varArray As Variant, CSA As String
Dim objExcel As New Excel.Application, objSheet As Excel.Worksheet, objChart As Excel.Chart
Dim intFields As Integer, intRows As Integer, intFld As Integer, intRow As Integer
Dim strRange As String, strCriteria As String, blChart As Boolean
DoCmd.Hourglass True
Set dbs = CurrentDb
strCriteria = "Select * from FebruaryKBUsage where TeamManager = '" & TeamManager & "' "
Set recData = dbs.OpenRecordset(strCriteria)
recData.MoveLast
recData.MoveFirst
varArray = recData.GetRows(recData.RecordCount)
intFields = UBound(varArray, 1)
intRows = UBound(varArray, 2)
objExcel.Workbooks.Add
objExcel.Visible = False
 
objExcel.Sheets("Sheet1").PageSetup.Orientation = xlLandscape
For intFld = 0 To intFields
objExcel.Cells(1, intFld + 1).Value = recData.Fields(intFld).Name
objExcel.Cells(1, intFld + 1).Font.Bold = True
objExcel.Cells(1, intFld + 1).Font.Size = 12
Next
recData.Close
For intFld = 0 To intFields
For intRow = 0 To intRows
objExcel.Cells(intRow + 2, intFld + 1).Value = varArray(intFld, intRow)
objExcel.Cells(intRow + 2, intFld + 1).HorizontalAlignment = xlCenter
Next
Next
Dim Rowcount As Integer
Rowcount = intRows + 2
objExcel.Cells(intRows + 3, 2).Value = "Team Average"
objExcel.Cells(intRows + 3, 3).Formula = "=sum(c2:c" & Rowcount & ")"
objExcel.Cells(intRows + 3, 3).HorizontalAlignment = xlCenter
objExcel.Cells(intRows + 3, 4).Formula = "=sum(d2:d" & Rowcount & ")"
objExcel.Cells(intRows + 3, 4).HorizontalAlignment = xlCenter
Rowcount = Rowcount + 1
objExcel.Cells(intRows + 3, 5).Formula = "=C" & Rowcount & "*100/d" & Rowcount
objExcel.Cells(intRows + 3, 5).HorizontalAlignment = xlCenter
objExcel.Sheets("Sheet2").Visible = False
objExcel.Sheets("Sheet3").Visible = False
objExcel.Sheets("Sheet1").Activate
objExcel.Sheets("Sheet1").Columns("A:G").EntireColumn.AutoFit
objExcel.Sheets("Sheet1").Columns("E:E").EntireColumn.NumberFormat = "0.00"
objExcel.Sheets("Sheet1").Columns("G:G").EntireColumn.NumberFormat = "0.00"
objExcel.Sheets("Sheet1").Select
objExcel.Sheets("Sheet1").Name = " Monthly Usage "
objExcel.ActiveWorkbook.SaveAs FileName:="H:\Monthly Reports\" & TeamManager & " " & MonthName & " - Monthly.xls"
objExcel.ActiveWorkbook.Close
Set objChart = Nothing
Set objExcel = Nothing
DoCmd.Hourglass False
Exit Sub

 

[Paul_birm]

thanks for your efforts guys...

I will give those a blast .. watch out for an update

regards
Paul

 

[Paul_birm]

thanks guys for your input.

however, I have studied your code (both) and I dont understand enough bout VBA to alter either code portion for my needs.

I have inserted your code into my VBA app, and looked at altering but cant find my way around.

as a workaround, i have used a crosstab query and it 'sort of' works ( my user 'could' export the data to excel himself) but i need answer 1 + answer 2, then answer 3 + 4 (etc) to be displayed and i am just getting answer 1, 2, 3 etc

so i am not really sure what i what, can be done

 

[boblarson]

Perhaps this code which exports a form's recordset will help. If you have the information displayed in a form this code will send it to Excel. Copy this into a new standard module and then call it from the form by using:

Send2Excel Me

'---------------------------------------------------------------------------------------
' Procedure : Send2Excel
' Author    : Bob Larson
' Date      : 5/25/2008
' Purpose   : Send any single recordset form to Excel.  This will not work with
'             subforms.
' Use       : You may freely use this code as long as the author information in
'             this header remains intact
'---------------------------------------------------------------------------------------
'
Public Function Send2Excel(frm As Form, Optional strSheetName As String)
' frm is the name of the form you want to send to Excel
' strSheetName is the name of the sheet you want to name it to


    
    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim intCount As Integer
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107

    On Error GoTo err_handler

    Set rst = frm.RecordsetClone

    Set ApXL = CreateObject("Excel.Application")
    Set xlWBk = ApXL.Workbooks.Add
    ApXL.Visible = True
        
    Set xlWSh = xlWBk.Worksheets("Sheet1")
    If Len(strSheetName) > 0 Then
        xlWSh.Name = Left(strSheetName, 34)
    End If
    xlWSh.Range("A1").Select
    Do Until intCount = rst.Fields.Count
        ApXL.ActiveCell = rst.Fields(intCount).Name
        ApXL.ActiveCell.Offset(0, 1).Select
        intCount = intCount + 1
    Loop

    rst.MoveFirst
    xlWSh.Range("A2").CopyFromRecordset rst
    xlWSh.Range("1:1").Select
    ' selects all of the cells
    ApXL.ActiveSheet.Cells.Select
    ' does the "autofit" for all columns
    ApXL.ActiveSheet.Cells.EntireColumn.AutoFit
    ' selects the first cell to unselect all cells
    xlWSh.Range("A1").Select

    rst.Close
    Set rst = Nothing

    Exit Function
err_handler:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    Exit Function

End Function

 

[Paul_birm]

thanks Bob, will give that a blast, I am fairly new to VB ( recently moved from a PICK basic environment - multivalued database - so used to the that syntax, but your code looks easy enough to read)

 

[seashton]

THANKS...The code works fine, but I would like to modify this code a little so I can export to sheet2 of a specific named excel file so I can link certain sheet1 cells to the sheet2 cells I just exported in from access. Can someone help me on what to modify in the code?