Solved Find Table Name (1 Viewer)

jeran042

Registered User.
Local time
Today, 14:07
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.

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
 

cheekybuddha

AWF VIP
Local time
Today, 22:07
Joined
Jul 21, 2014
Messages
2,276
try it like this:
Code:
' ...
    sTable = oSheet.ListObjects(1).Name 'This is where I can use some help
    Set tbl = oSheet.ListObjects(sTable) 'This is where I can use some help
' ...
You already have the reference to the sheet. The ListObject is a property of the sheet.

hth,

d
 

jeran042

Registered User.
Local time
Today, 14:07
Joined
Jun 26, 2017
Messages
127
try it like this:
Code:
' ...
    sTable = oSheet.ListObjects(1).Name 'This is where I can use some help
    Set tbl = oSheet.ListObjects(sTable) 'This is where I can use some help
' ...
You already have the reference to the sheet. The ListObject is a property of the sheet.

hth,

d
Thank you, this helped. I changed it from:
Code:
sTable = oSheet.ListObjects(1).Name 'This is where I can use some help
    Set tbl = oSheet.ListObjects(sTable)
to
Code:
    sTable = .ListObjects(1).Name
    Set tbl = .ListObjects(sTable)
 

cheekybuddha

AWF VIP
Local time
Today, 22:07
Joined
Jul 21, 2014
Messages
2,276
Quite! Since you are within a With oSheet ... End With block, you can refer to the properties directly without having to repeat the oSheet qualification.

👍

d
 

Users who are viewing this thread

Top Bottom