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.