Modificación Macro envió archivos adjuntos con mensajes
Como siempre vengo con consultas de Macros que no puedo resolver, trabajo en una empresa donde se generan ordenes de compra, y se envia por cada orden de compra 1 mail a unas direcciones de mails especificas, con adjuntos específicos. Uso una macro de Dante para reclamos sin adjuntos y encontre en internet una Macro que envia adjuntos, el problema es que si quiero enviar 10 ordenes, si un adjunto no lo encuentra bien tira un error y frena todo, y no aclara cual es el error. Quisiera saber si alguno se le ocurre como mejorar esta macro para que no emita error, o mejor aun me identifique donde esta el error para corregirlo. Por cierto, vale aclarar que la Macro es bajada de internet y siempre y cuando este todo perfecto, funciona.
Les dejo la screen del error, el código de la macro y un enlace al archivo que utilizo, cualquier ayuda como siempre bienvenida!
'Funcion para hallar el ultimo registro de una hoja partiendo de una referencia (Fila, Columna y Hoja)
Public Function URegistro(Fila As Long, Columna As Long, Hoja As Worksheet) As Integer
Do While Hoja.Cells(Fila, Columna) <> ""
Fila = Fila + 1
Loop
URegistro = Fila - 1
End Function
Sub Enviar_Correos()
Dim Final As Long
Dim Email As Object
Final = URegistro(6, 1, HEmail)
For f = 7 To Final
Set Email = CreateObject("Outlook.Application").CreateItem(0)
'
Email.To = Range("A" & f).Value 'Destinatarios
Email.Cc = Range("B" & f).Value 'Con copia
Email.Bcc = Range("C" & f).Value 'Con copia oculta
Email.Subject = Range("D" & f).Value 'Asunto
Email.Body = Range("E" & f).Value 'Cuerpo del mensaje
'
For c = 6 To 10
Archivo = Cells(f, c).Value
If Archivo <> "" Then Email.Attachments.Add Archivo
Next
' Email.Display 'El correo se muestra
Email.Send 'El correo se envía en automático
Next
MsgBox "Se han enviado " & f - 7 & " correos de forma Exitosa", vbInformation, "Correos Enviados"
End Sub
1 Respuesta
Te paso la macro actualizada:
Sub Enviar_Correos()
'Act.Por Dante Amor
Dim i As Long, c As Long
Dim Email As Object
Dim archivo As String
For i = 7 To Range("A" & Rows.Count).End(3).Row
Set Email = CreateObject("Outlook.Application").CreateItem(0)
'
Email.To = Range("A" & i).Value 'Destinatarios
Email.Cc = Range("B" & i).Value 'Con copia
Email.Bcc = Range("C" & i).Value 'Con copia oculta
Email.Subject = Range("D" & i).Value 'Asunto
Email.Body = Range("E" & i).Value 'Cuerpo del mensaje
'
For c = 6 To 10
archivo = Cells(i, c).Value
If archivo <> "" And Dir(archivo) <> "" Then Email.Attachments.Add archivo
Next
' Email.Display 'El correo se muestra
Email.Send 'El correo se envía en automático
Next
MsgBox "Se han enviado " & i - 7 & " correos de forma Exitosa", vbInformation, "Correos Enviados"
End SubPrueba y comentas. Si funciona no olvides la valoración.
