Hey there!
I created a VBA application in my Acess database. This application generates lots of worksheets within lots of workbooks to calculate meteorological stuff. I am trying to calculate the average of a column in a recordset containing data retrieved from my access database. This recordset is used to fill sheets in my workbooks.
I mean. For each meteorological station i create a workbook with 12 worsheets (one sheet for each month of the year). I fill those worksheets querying my database within a loop from 1 to 12. In each step of my loop the recordset contains a column with a date and another colum with pluviosity totals (just numbers). I just wanna calculate the average of this totals column and put it into a previously created worbook to agregate all the stations and its monthly averages (the translation to portuguesE of AVERAGE is MÉDIA). Here's my perfectly working code till now:
thank you for the help
I created a VBA application in my Acess database. This application generates lots of worksheets within lots of workbooks to calculate meteorological stuff. I am trying to calculate the average of a column in a recordset containing data retrieved from my access database. This recordset is used to fill sheets in my workbooks.
I mean. For each meteorological station i create a workbook with 12 worsheets (one sheet for each month of the year). I fill those worksheets querying my database within a loop from 1 to 12. In each step of my loop the recordset contains a column with a date and another colum with pluviosity totals (just numbers). I just wanna calculate the average of this totals column and put it into a previously created worbook to agregate all the stations and its monthly averages (the translation to portuguesE of AVERAGE is MÉDIA). Here's my perfectly working code till now:
Code:
Public Function createFillWorkbooks() As String
'Excel objects
Dim objXL As Excel.Application
Dim avgXL As Excel.Application
Dim objWbk As Excel.Workbook
Dim avgWbk As Excel.Workbook
Dim objWks As Excel.Worksheet
Dim avgWks As Excel.Worksheet
Dim objRng As Excel.Range
'Miscelaneous objects
Dim objTable As AccessObject
Dim rcdSet As Recordset
Dim qryDef As QueryDef
Dim codMon As Integer, _
totalAvg As Integer
Dim codSt As String
Dim strPath As String, _
strAvgPath As String, _
strSheetName As String, _
strRng As String, _
strMon As String, _
strSQL As String
'setup the MEDIAS - ANA table
Set avgXL = New Excel.Application
avgXL.SheetsInNewWorkbook = 1
avgXL.Visible = True
strAvgPath = CurrentProject.Path & "\" & "mediasANA.xls"
If testFileExistence(strAvgPath) Then
Set avgWbk = avgXL.Workbooks.Open(strAvgPath)
avgWbk.Save
Else
Set avgWbk = avgXL.Workbooks.Add
avgWbk.SaveAs FileName:=strAvgPath, ReadOnlyRecommended:=False
End If
Set avgWks = avgWbk.Worksheets(1)
avgWks.Name = "Médias"
For Each objTable In Application.CurrentData.AllTables
If (objTable.Name = "Chuvas") Then
'setup the station workbook and recordset
strSQL = "SELECT DISTINCT EstacaoCodigo as stCode FROM " & objTable.Name
Set rcdSet = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
codSt = rcdSet!stCode
If rcdSet.RecordCount <> 1 Then
Debug.Print "More than one station in table " & objTable.Name
rcdSet.MoveFirst
End If
strPath = CurrentProject.Path & "\" & codSt & ".xls"
Set objXL = New Excel.Application
objXL.SheetsInNewWorkbook = 1
objXL.Visible = True
If testFileExistence(strPath) Then
Set objWbk = objXL.Workbooks.Open(strPath)
objWbk.Save
Else
Set objWbk = objXL.Workbooks.Add
objWbk.SaveAs FileName:=strPath, ReadOnlyRecommended:=False
End If
objWbk.Activate
Set rcdSet = Nothing
'update query for each month of the year and fill sheets in current workbook
For codMon = 1 To 12
strSQL = "SELECT Data,Total FROM " & objTable.Name & " WHERE Month(Data) = " & codMon
Set rcdSet = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
If testSheetExistence(objWbk, codSt & MonthName(codMon)) Then
Set objWks = objWbk.Sheets(codSt & MonthName(codMon))
Else
Set objWks = objWbk.Sheets.Add
objWks.Name = codSt & MonthName(codMon)
objWks.Columns(1).Name = "Data"
objWks.Columns(2).Name = "Total"
End If
If testSheetExistence(objWbk, "Sheet1") Then
objWbk.Sheets("Sheet1").Delete
Debug.Print "DELETANDO SHEET1"
ElseIf testSheetExistence(objWbk, "Plan1") Then
objWbk.Sheets("Plan1").Delete
Debug.Print "DELETANDO PLAN1"
Else
Debug.Print "SHEET1 NÃO ENCONTRADA"
End If
Set objRng = objWks.Range("A1")
objRng.CopyFromRecordset rcdSet
objWks.Columns.AutoFit
Set rcdSet = Nothing
Next codMon
objWbk.Save
End If
Next objTable
End Function
thank you for the help
Last edited: