2 ThisWorkbook instances in VBA Project

Question

I have 2 subs and a function (code below) that I use to share some reports in bulk via Outlook. I've been using this for more than a year now without issues, but now something really strange happens when I run it: it creates two (2) "ThisWorkbook" instances in my Microsoft Excel Objects section in VBA. As if the workbook itself developed a double-personality or something. This creates an Automation Failure fatal error when opening the Workbook, but only when I open it after having using it at least once before (if instead I recreate the whole workbook in a new file, copy-paste the code and everything there, it will work fine the first time around, then the 2nd time again give me the same issues I described above). Not sure what to do to fix this, I've been trying to rebuild it multiple time with the same issues.

Option Explicit

Public Sub Send()
    Dim olApp As Object
    Dim olMail As Object
    Dim olRecip As Object
    Dim olAtmt As Object
    Dim olAtmt2 As Object
    Dim iRow As Long
    Dim Recip As String
    Dim Subject As String
    Dim atmt As String
    Dim Atmt2 As String
    Dim LBBReport, CRaPReport As Boolean
    
    iRow = 2
    
    Set olApp = CreateObject("Outlook.Application")
    Dim Sht As Worksheet
    Set Sht = Workbooks("VoS macro - DE.xlsm").Worksheets("Sender")
    
    Do Until IsEmpty(Sht.Cells(iRow, 1)) 'starts the loop
        LBBReport = False
        CRaPReport = False
        Recip = Sht.Cells(iRow, 2).Value 'Email address
        Subject = Sht.Cells(iRow, 3).Value 'Subject of the email
        atmt = Sht.Cells(iRow, 4).Value 'CRaP path
        Atmt2 = Sht.Cells(iRow, 5).Value 'LBB path
        
        If Sht.Cells(iRow, 9) = "" And Sht.Cells(iRow, 1) <> "" Then 'checks if the row was processed previously and if the row contains any values or is blank
            If Dir(atmt) <> "" Then 'checks if CRaP report exists in the folder
                CRaPReport = True
                Sht.Cells(iRow, 6) = "Y" 'case when CRaP data exists > marks with Y
            Else
                Sht.Cells(iRow, 6) = "N" 'case when CRaP data does not exist > marks with N
            End If
            
            If Dir(Atmt2) <> "" Then 'checks if LBB report exists in the folder
                LBBReport = True
                Sht.Cells(iRow, 7) = "Y" 'case when LBB data exists > marks with Y
            Else
                Sht.Cells(iRow, 7) = "N" 'case when LBB data does not exist > marks with N
            End If
            
            Sht.Cells(iRow, 9) = "Y"
            Set olMail = olApp.CreateItem(0)
            If LBBReport = True Or CRaPReport = True Then
                
                With olMail
                    .Body = Sht.Cells(1, 11) 'Blurb to be added in the body of the emails"
                    .SentOnBehalfOfName = "selection@email.com"
                    .to = Recip 'Recipient of the email
                    .Subject = Subject
                    .Attachments.Add (atmt) 'add CRaP report (if available)
                    .Attachments.Add (Atmt2) 'add LBB report (if available)
                    .Display
                    
                    If .Attachments.Count > 0 Then ' check if there are any attachments to be sent
                        .Send 'if at least one attachment present, sends the email
                    Else
                        .Close 1 'if no attachment present, discards the email
                    End If
                    
                End With
            End If
        End If
        On Error Resume Next
        iRow = iRow + 1
        
    Loop
    
    Set olApp = Nothing
End Sub

Sub PrepareInput()
    
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    
    'open contactlist1 excel file
    Dim src As Workbook
    Set src = Workbooks.Open("C:\Users\" & UserName() & "\Downloads\contactlist1.xlsx", True, True)
    
    Application.AskToUpdateLinks = True
    Application.DisplayAlerts = True
    
    Workbooks("VoS macro - DE.xlsm").Activate
    
    'clear existing contents
    Sheets("Contact list").Select
    Range("A1:Q20001").ClearContents
    Sheets("Sender").Select
    Range("F2:G20001").ClearContents
    Range("I2:I20001").ClearContents
    
    src.Sheets("Sheet1").Cells.Copy Destination:=Workbooks("VoS macro - DE.xlsm").Sheets("Contact list").Range("A1")
    
End Sub

Public Function UserName()
    UserName = Environ$("UserName")
End Function