jeran042
Registered User.
- Local time
- Today, 03:15
- Joined
- Jun 26, 2017
- Messages
- 127
I have a procedure that will export various recordsets to already created excel workbooks, and all works fine except for one part.
I need to dynamically find a table name on a specific tab so it can be cleared out and the new data pasted in. As of yet I am not having any luck.
Here is what I have so far. It would appear that the table name is not being pulled. I'm sure I am not doing something correctly:
Full disclosure I have posted this code in this forum before, but not for this particular question.
I need to dynamically find a table name on a specific tab so it can be cleared out and the new data pasted in. As of yet I am not having any luck.
Here is what I have so far. It would appear that the table name is not being pulled. I'm sure I am not doing something correctly:
Full disclosure I have posted this code in this forum before, but not for this particular question.
Code:
Private Sub Command47_Click()
'BOF checks if current record position is before the first record
'EOF checks if current record position is after the last record
'If BOF and EOF both return TRUE, then the Table has no record
'rs.MoveFirst ‘makes the first record the current record, in case current record is not the first record
'Error handling
On Error GoTo Error_Handler
Dim sCost As String
Dim rsQuery_expense As DAO.Recordset
Dim rsQuery_head As DAO.Recordset
Dim rsQuery_temp_head As DAO.Recordset
Dim rs As DAO.Recordset
Dim dbs As DAO.Database
Dim excelApp As Object
Dim sFilePath As String
Dim sDepartment As String
Dim oSheet As Object
Dim oBook As Object
'This RS is departments who are a stakeholder in an Exhibit 2 line
Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("SELECT * FROM qryDepartmentActive")
'Set Variables
sFilePath = "Y:\Budget process information\BUDGET DEPARTMENTS\"
sSubFolder = "\MONTHLY EXPENSE REPORTS\"
'Check to see if the recordset actually contains rows
'Do until there are no more records in the RS
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
sCost_Center = rs.Fields("COST_CENTER")
sDepartment = DLookup("DEPARTMENT", "qryDepartment", "COST_CENTER = " & sCost_Center)
'Specify the query to be exported
Set rsQuery_expense = dbs.OpenRecordset("SELECT * FROM qryLedger_Detail_2019_Exhibit WHERE [EXHIBIT_2_COST] = " & sCost_Center & " Or [COST_CENTER] = " & sCost_Center)
Set rsQuery_head = dbs.OpenRecordset("SELECT * FROM qry_HEAD_COUNT_AGG_ALL WHERE TBL_HEAD_COUNT_AGG.COST_CENTER = " & sCost_Center)
Set rsQuery_temp_head = dbs.OpenRecordset("SELECT * FROM qry_TEMP_HEAD_COUNT_AGG_ALL WHERE TBL_TEMP_HEAD_COUNT_AGG.COST_CENTER = " & sCost_Center)
'Open an instance of Excel
On Error Resume Next
Set excelApp = GetObject(, "Excel.Applicationn")
If Err.Number <> 0 Then
Err.Clear
'On Error GoTo Error_Handler
Set excelApp = CreateObject("Excel.Application")
End If
Debug.Print "Excel Instance Created"
'Change True to False if you do not want the workbook to be
'Visible when the code is running
excelApp.Visible = False
'Open the target workbook
Set targetWorkbook = excelApp.Workbooks.Open(sFilePath & sDepartment & sSubFolder & sDepartment & "_YTD_DETAIL" & ".xlsm")
Debug.Print "Excel File " & sDepartment & " Opened"
#######################################################################
'This is where I can use some help
'Dim tbl As ListObject
Dim sTable As String
For Each oSheet In targetWorkbook.worksheets
With oSheet
'MsgBox oSheet.Name
If oSheet.Name = "EXHIBIT_2_DETAIL_2020" Then
sTable = oSheet.Name.ListObjects(1).Name 'This is where I can use some help
Set tbl = oSheet.Name.ListObjects(sTable) 'This is where I can use some help
With oSheet.ListObjects(sTable)
If Not .DataBodyRange Is Nothing Then
.DataBodyRange.Delete
End If
End With
oSheet.Range("A2").CopyFromRecordset rsQuery_expense
Debug.Print "Completed the export of Expense Detail For " & sDepartment
#######################################################################
ElseIf oSheet.Name = "HEAD_TEMP_COUNT" Then
oSheet.Range("B3").CopyFromRecordset rsQuery_head
oSheet.Range("A9").CopyFromRecordset rsQuery_temp_head
Debug.Print "Completed the export of Head Count and Temp Head Count For " & sDepartment
ElseIf oSheet.Name = "PIVOTS" Then
oSheet.Range("A1").Value = "EXPENSES REPORT UPDATED: " & Now
Debug.Print "Report Updated to reflect " & Now & " Timestamp"
End If 'There will be other sheets in workbook, but the 2 above are the only ones i need to interact with.
End With
Next oSheet
'Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set excelApp = Nothing
targetWorkbook.Close True
Debug.Print sDepartment & " Excel Workbook has been saved and Closed"
Set targetWorkbook = Nothing
'Debug.Print that we are moving to the next record with 2 line breaks in between
Debug.Print "Moving to the next Recordset" & vbNewLine & StringTwo
Loop
'Move to the next recordset
rs.MoveNext
Debug.Print "Moving to the next Recordset" & vbNewLine & StringTwo
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
'Close the recordset & clean up
rs.Close
Set rs = Nothing
Error_Handler_Exit:
'Close the EXCEL file while saving the file, and clean up the EXCEL objects
Set excelApp = Nothing
targetWorkbook.Close True
Set targetWorkbook = Nothing
rs.MoveNext
Exit Sub
Error_Handler:
Select Case Err.Number
Case 2302
MsgBox "There is currently a file open with the name: " & vbCrLf & _
sFilename & vbCrLf & _
"Please close or rename open file! " _
, vbOKOnly + vbExclamation, "DUPLICATE NAME WARNING"
Resume Error_Handler_Exit
Case Else
MsgBox "Error No. " & Err.Number & vbCrLf & "Description: " & Err.DESCRIPTION, vbExclamation, "Database Error"
Err.Clear
Resume Error_Handler_Exit
End Select
End Sub