How to identify ThisWorkbook module using VBA

Question

Using Excel 2010.

I need to add code to a remote Excel file where ThisWorkbook has been renamed, say, “DashboardWorkbook”. I don’t know, but the new name can be anything, but I need to identify this module programmatically to add additional code to Sub Workbook_Open ().

I open this remote file, then look through all its components:

Private Sub AddProcedureToWorkbook(wb As Workbook)
  Dim VBProj As VBIDE.VBProject
  Dim oComp As VBIDE.VBComponent
  Dim oCodeMod As VBIDE.CodeModule

  Set VBProj = wb.VBProject 
  For Each oComp In VBProj.VBComponents
    If *[check here if oComp was formerly ThisWorkbook but now renamed]* Then
      Set oCodeMod = oComp.CodeModule
        'add new code here
      ...etc, etc
    End If
  Next

End Sub

This book has a different icon in the Excel interface, so it seems to be a different type of module, but I couldn’t understand what specific property needs to be read in order to identify it?

To complicate things, sometimes Sub Workbook_Open () does not exist, so I need to add it to the right place ...

Thanks,

Mr

Answer 1

CodeName ( aka just Name).
VBComponent.

Private Sub AddProcedureToWorkbook(wb As Workbook)
  Dim VBProj As VBIDE.VBProject
  Dim oComp As VBIDE.VBComponent
  Dim oCodeMod As VBIDE.CodeModule

  Set VBProj = wb.VBProject
  Set oComp = VBProj.VBComponents(wb.CodeName)
  Set oCodeMod = oComp.CodeModule

  oCodeMod.AddFromString "sub Hi()" & vbNewLine & "msgbox ""Hi.""" & vbNewLine & "end sub"
End Sub

Answer 2

VBProj.VBComponents Properties. Workbook (, ..).

.

Private Function FindThisWorkbook(wb As Workbook) As VBIDE.VBComponent
    Dim VBProj As VBIDE.VBProject
    Dim oComp As VBIDE.VBComponent
    Dim oP As Property

    Set VBProj = wb.VBProject
    For Each oComp In VBProj.VBComponents
        Set oP = Nothing
        On Error Resume Next
        Set oP = oComp.Properties("ActiveSheet")
        On Error GoTo 0
        If Not oP Is Nothing Then
            ' Found it
            Set FindThisWorkbook = oComp
            Exit Function
        End If
    Next

End Function