Como unir una macro que consolida archivos con una que envia correos automaticamenta?

Estoy intentando automatizar un proceso el cual tiene los siguientes pasos:

1. Se reciben 3 correos con archivos adjuntos.

2. Se consolidan los archivos.

3. Se crea una tabla dinamica con la informacion.

4. Se guarda el arcivo y se envia `por correo.

En este momento ya tengo todos los codigos o macros funcionando correctamente para todos los pasos anteriores, el problema es que al unir las macros me genera error en la macro de envio de los correos "-2417467259 (80004005) en tiempo de ejecucion" "Debe haber como minimo un nombre o grupo de contactos en los cuadros para, CC O CCO" y en la macro al depurar me muestra en amarillo " dam.send 'El correo se envía en automático", estas son las macros que estoy usando:

Macro1. Esta me consolida los archivos y al final los depura y crea una tabla dinamica con "Application.Run "Actualizar"" que es otra macro dque solo hace la depuracion de los archivos:

Sub Consolida()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Control = 0
mio = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path & "\"
Set fso = CreateObject("scripting.filesystemobject")
Set carpeta = fso.getfolder(ruta)
For Each archivo In carpeta.Files
If archivo = ruta & mio Then GoTo salto
If archivo = ruta & "~$" & mio Then Exit Sub
Workbooks.Open archivo
otro = ActiveWorkbook.Name
Sheets(1).Select
If Control = 0 Then
Range("A5").Select
Range(Selection, Selection.End(xlToRight)).Copy Destination:=Workbooks(mio).Sheets(4).Range("a1")
Control = 1
End If
Range("a1").CurrentRegion.Select
Selection.Offset(5, 0).Resize(Selection.Rows.Count - 1, Selection.Columns.Count).Copy
Workbooks(mio).Sheets(4).Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Workbooks(otro).Close False
Application.Run "Actualizar"
salto:
Next
End Sub

macro2. Esta es la que hace la depuracion como lo mecione anteriormenta:

Sub actualizar()

Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.Replace What:="~*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="_", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.End(xlUp).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select
ActiveSheet.Next.Select
ActiveWorkbook.RefreshAll
End Sub

macro3. Esta envia los correos automaticamente:

Sub correo()
col = Range("H1").Column
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = Range("B" & i) 'Destinatarios
dam.CC = Range("C" & i) 'Con copia
dam.Bcc = Range("D" & i) 'Con copia oculta
dam.Subject = Range("E" & i) '"Asunto"
dam.body = Range("F" & i) '"Cuerpo del mensaje"
'
For j = col To Cells(i, Columns.Count).End(xlToLeft).Column
archivo = Cells(i, j)
If archivo <> "" Then dam.Attachments.Add archivo
Next
dam.send 'El correo se envía en automático
'dam.display 'El correo se muestra
Next
End Sub

macro4. Esta une todo el proceso:

Sub macroGeneral()
Call Consolida
Call correo
End Sub

Pero me genera el error que meciono anteriormente, cabe aclara que todas las macros funcionan perfectamente por separado a excepcion de "Sub macroGeneral()".

Estaria muy muy agradecido si alguien me puede ayudar pues la verdad hasta hace poco estoy en el tema de VB y no se mucho al respecto ya que todas las macros que estoy usado las saque de esta pagina y las e ido madificando segun mi necesidad pero eso a prueba y error, pero en este punto ya no pude resolverlo.

1 Respuesta

Respuesta
1

En lugar de Call, utiliza la instrucción Application. Run de la siguiente manera.

Application. Run "Consolida"
Application. Run "correo"

Buenas tardes,

Gracias por la ayuda William, ya realice el cambio pero sigue generando el mismo error, creo que la macro o la hoja de envío de correo tiene alguna restricción y al ejecutar la macro del correo debe estar seleccionada la hoja donde están los datos de envío para el correo, y aun no he podido ejecutar el proceso.

De nuevo mil gracias por su pronta respuesta.

En este caso puedes crear una nueva consulta para que algún otro experto pueda ayudarte con ese detalle.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas