Export to Excel

[RobinAG]

Hello

I've created an Excel spreadsheet to export word count and project count per week, per language, for a Translation company. This code works, however, only for one language at a time. The report must include 8 separate languages in separate data ranges on the same spreadsheet, and I'm at a standstill of how to set it up so that I don't have to copy the code 8 different times. I thought about using varLanguage to pass through from a separate module, but I can't get Excel to save the data new each time. Any ideas?

Public Function MonthlyReportExport(varLanguage As Variant)
 
   On Error GoTo err_Handler
 
   Dim appExcel As Excel.Application
   Dim wbk As Excel.Workbook
   Dim wks As Excel.Worksheet
   Dim sTemplate As String
   Dim sOutput As String
 
   Dim dbs As dao.Database
   Dim rst As dao.Recordset
   Dim sSQL As String
   Dim iWeeks As Integer
   Dim lWords As Long
   Dim lProjects As Long
   Dim sRange As String
   Dim vStartDate As Variant
   Dim vEndDate As Variant
 
   Set vStartDate = Forms!frmReports!StartDate
   Set vEndDate = Forms!frmReports!EndDate
 
   DoCmd.Hourglass True
 
   Application.SetOption "Error Trapping", 0
 
   sTemplate = "C:\Test\Test.xls"
   sOutput = "C:\Test\Export.xls"
 
   Set appExcel = Excel.Application
   Set wbk = appExcel.Workbooks.Open(sOutput)
   Set wks = appExcel.Worksheets(1)
 
sSQL = "SELECT Count(tblProject.ProjectID) AS CountOfProjectID, Sum(tblProject.WordCount) AS SumOfWordCount FROM (tblProject INNER JOIN tblOffice ON tblProject.OfficeID = tblOffice.OfficeID) INNER JOIN tblTypes ON tblOffice.OfficeTypeID = tblTypes.TypeID WHERE (((tblProject.CombinedRequestDate) Between #" & vStartDate & "# And #" & vEndDate & "#) AND ((tblTypes.Option)='school') AND ((tblProject." & varLanguage & ")=-1)) ORDER BY Count(tblProject.ProjectID);"
 
   Set dbs = CurrentDb
   Set rst = dbs.OpenRecordset(sSQL)
 
  iWeeks = (DateDiff("ww", vStartDate, vEndDate, , vbFirstJul1))
  lProjects = rst.Fields("CountOfProjectID").Value / iWeeks
  lWords = rst.Fields("SumOfWordCount").Value / iWeeks
  rst.Close
  dbs.Close
 
  sSQL = "SELECT " & lProjects & ", " & lWords & ";"
 
  Set dbs = CurrentDb
  Set rst = dbs.OpenRecordset(sSQL)
  sRange = "School_" & varLanguage & ""
 
wks.Range(sRange).CopyFromRecordset rst
 
exit_Here:
   ' Cleanup all objects  (resume next on errors)
   On Error Resume Next
   Set wks = Nothing
   Set wbk = Nothing
   Set appExcel = Nothing
   Set rst = Nothing
   Set dbs = Nothing
   DoCmd.Hourglass False
   Exit Function
 
err_Handler:
   ExportRequest = Err.Description
   Resume exit_Here
 
End Function

[MMcCarthy]

Assuming this passes to just one row in the spreadsheet ...

Pass a second parameter to the code incrementing the row position and call the function in a loop incrementing the row position each time.

[RobinAG]

Assuming this passes to just one row in the spreadsheet ...

Pass a second parameter to the code incrementing the row position and call the function in a loop incrementing the row position each time.

Thanks, that's just what I did.

[MMcCarthy]

Thanks, that's just what I did.

Glad it worked for you.