Invio massivo conallegati

Salve a tutti

sto utilizzando la seguente macro per inviare mail massive con outlook avendo come file di dati un foglio excel
Il problema che dopo 10 invii automatici la macro mi restituisce il seguente errore:

Errore di run-time '-2147467259 (80004005)':
Errore di automazione
Errore non specificato.

La macro è la seguente::

Sub StampaUnioneConAllegati()

Dim OutApp As Object
Dim OutMail As Object
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim FileAllegato As String
Dim CartellaAllegati As String

' Imposta il foglio di lavoro e l'ultima riga dei dati
Set ws = ThisWorkbook.Sheets("TestInvioComunicazione")

lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

' Crea una nuova istanza di Outlook
Set OutApp = CreateObject("Outlook.Application")

' Percorso della cartella contenente gli allegati
CartellaAllegati = "C:\Documenti\Cooplat\Invio Massivo\FileRinominati\"

' Loop attraverso ogni riga del foglio di lavoro
For i = 2 To lastRow ' Assumendo che la riga 1 contenga le intestazioni

' Recupera i dati della riga corrente
Dim NomeDestinatario As String
Dim EmailDestinatario As String
Dim NomeFile As String

NomeDestinatario = ws.Cells(i, 1).Value
EmailDestinatario = ws.Cells(i, 2).Value
NomeFile = ws.Cells(i, 3).Value

' Crea un nuovo messaggio di posta elettronica
Set OutMail = OutApp.CreateItem(0) ' 0 rappresenta olMailItem

With OutMail
.To = EmailDestinatario
.Subject = "Ricalcolo lavoro svolto nel periodo decorrente dal 07/2024 al 01/2025"
.Body = "La preghiamo di prendere visione della comunicazione allegata." & vbCrLf & _
"Cordiali saluti.Cordiali saluti." & vbCrLf & _
"COOPLAT."

' Aggiungi l'allegato (nome del file più percorso)
FileAllegato = CartellaAllegati & NomeFile
If Dir(FileAllegato) <> "" Then
.Attachments.Add FileAllegato
Else
MsgBox "File non trovato: " & FileAllegato
End If

' Visualizza o invia direttamente l'email
'.Display() ' Per controllare l'email prima di inviarla
.Send ' Per inviare l'email direttamente

End With

' Rilascia l'oggetto email
Set OutMail = Nothing
Next i

' Chiudi Outlook
Set OutApp = Nothing

MsgBox "Processo completato - " & (i - 2) & " mail inviate"

End Sub

Ringrazio per qualunque suggerimento possiate darmi