Error definido por la aplicación o el objeto

Tengo este código que cuando lo ejecuto me sale el error "Error definido por la aplicación o el objeto vba", ya he revisado todo y he intentado de todo pero no encuentro el error, recurro a su apoyo y experiencia para encontrar y solucionar ese error, muchas gracias.
PD: distorsione el correo y la clave de acceso
* ** * ** ** *   * * * * * *  ** ** *  **  * * ** * ** * *  **  *** * *
Sub ENVIO_CORREOS_202()
'Definiciones para el correo 203
Dim Email As CDO.Message
Dim Remitente As String
Dim Pass As String
Dim Destinatario As String
Dim Asunto As String
Dim Cuerpo As String
'Definiciones para archivo 203
Dim RutaTemporal As String
Dim NombreTemporal As String
Dim RutaCompleta
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Creación del archivo temporal 203
RutaTemporal = Environ$("temp") & "\"
NombreTemporal = Sheets("201-202").Range("G34") & ".pdf"
RutaCompleta = RutaTemporal & NombreTemporal
On Error GoTo Err
Sheets("201-202").Range("A29:F43").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=RutaCompleta, _
quality:=xlQualityStandard, _
includedocproperties:=True, _
ignoreprintareas:=False, _
openafterpublish:=False
'Información para el correo 203
Set Email = New CDO.Message
Remitente = "[email protected]"
Pass = "xxxxxx"
Destinatario = "[email protected],[email protected]"
Asunto = Sheets("201-202").Range("G29")
Cuerpo = Sheets("201-202").Range("32")
Email.CC = "[email protected]"
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(25)
.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Remitente
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
.To = Destinatario
.From = Remitente
.Subject = Asunto
.TextBody = Cuerpo
.AddAttachment RutaCompleta
.Configuration.Fields.Update
On Error Resume Next
.Send
End With
If Err.Number = 0 Then
MsgBox "Se enviaron los correos a Tipuanas con Exito", vbInformation, "RODACORP S.A.C"
Else
MsgBox "Se produjo el siguiente error: " & vbNewLine & _
Err.Description, vbCritical, "Error No. " & Err.Number
End If
On Error GoTo 0
Kill RutaCompleta
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
Err:
MsgBox Err.Description, vbCritical + vbOKOnly, Err.Number
End Sub

Añade tu respuesta

Haz clic para o