I have the following code in an Access Database. The issue we're trying to solve is we have an Excel Template that contains 45 Worksheets. The data for each worksheet comes from a SQL Server Query. The current process is to run each query and copy the data to the appropriate worksheet. I've redone the queries so they are now SQL Server Views. I have an Access 2010 that links to the SQL Server Views. Now what I'm trying to do is set up subroutine that can be called from the autoexec Macro to run VBA Code to grab each view and export to the appropriate worksheet in the template and save the template as an Excel Workbook. I have a table in Access that links each view to the appropriate Worksheet. Where I'm having a problem is in the line xlApp.Workbooks(WBName).Sheets(rs!worksheet).Activ ate I'm getting a runtime error 13 Type Mismatch. rs!Worksheet is the name of the worksheet I want to edit. WBName is the name of the workbook. What am I missing?
Code:
Public Sub export_to_Excel()
Dim rs As New ADODB.Recordset, lpctr As Long, WS As New ADODB.Recordset
Dim introw As Long, strsql As String, irow As Long, rsout As New ADODB.Recordset, strfld As String, lastrow As Long, lastcol As Long
Dim WBName As String
xlApp.Workbooks.Open "\\192.168.114.17\hvvhomefolders\rmilhon\unitedhealthcare_Remediation_2018\TEMPLATE - HVVMG - Oversight Monitoring Reports (SR_Part 1 of 2)_Updated_01282019_.xlsx"
xlApp.Workbooks(1).SaveAs "Oversight Monitoring Reports (SR_Part 1 of 2)_" & Format(Now(), "mmddyyyy") & ".xlsx"
WBName = Workbooks(1).Name
strsql = "SELECT * FROM tbl_worksheetformats;"
rs.Open strsql, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
Do Until rs.EOF
irow = rs!startrow
xlApp.Workbooks(1).Sheets(rs!Worksheet).Activate
strsql = "Select * From " & rs!Table
rsout.Open strsql, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
Do Until rsout.EOF
strsql = "Select * From tbl_worksheetformats Where Worksheet = """ & rs!Worksheet & """"
WS.Open strsql, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
Do Until WS.EOF
Set cell = xlApp.Workbooks(1).ActiveSheet.Cells(irow, WS!Column)
strfld = WS!Field
cell.Value = rsout.Fields(strfld)
WS.MoveNext
Loop
WS.Close
irow = irow + 1
rsout.MoveNext
Loop
Set cell = xlApp.Workbooks(1).ActiveSheet.Cells(irow + 1, rs!endCol)
cell.Value = irow
rsout.Close
rs.MoveNext
Loop
rs.Close
xlApp.Workbooks(1).Close
End Sub