Macro para generar ficheros y envío de correos
Estoy intentando generar una macro y me estoy liando yo sola sin salir a flote.
Tengo un fichero inicial donde tengo una lista de pedidos asociados a varios de nuestros vendedores.
Todas las semanas valoramos aquellos pedidos que no han sido confirmados antes de su fecha esperada de paso a producción e informamos a los vendedores.
Tarea repetitiva que quiero mecanizar y no hay forma .
¿Qué tengo?
1/Lista de pedidos : un excel con los detalles básicos de los pedidos, los dueños de esas cuentas y los que llevan esos territorios (con sus mails respectivos) . El fichero esta ordenado por vendedor y cuenta
2/Fichero modelo : donde pretendo, con una macro, coger del fichero 'lista de pedidos' y pegar SOLO lo que corresponde a cada vendedor (con independencia de quien lleva los territorios) . Algunas columnas están ocultas
Cada fichero se salvaría en formato PDF de la forma : AAAAMMDD Pedidos Vendedor1
3/ Generar una ultima macro que vaya enviando todos los PDFs a los vendedores con copia a los que gestionan los territorios . Una sola nota por vendedor
No se si se puede hacer que se vea el contenido de la lista de pedidos en el mail además de incluir el pdf. De esta forma seria mucho más visual para cada uno ver la lista que tiene que revisar
Yo sigo haciendo pruebas con mis macros pero me estoy volviendo loca y siempre que me ha pasado algo similar me has salvado la vida.
He salvado los ficheros en una carpeta en dropbox .
https://www.dropbox.com/sh/sxflumq57fg45d6/AABvoPE_qsLHFk0KQvxsEPiia?dl=0
¿Podrías intentar echar un vistazo?
Te anexo el código, solamente necesitas un libro con tres hojas: "Listado", "Formato" y "Temp"
Sub Enviar_Ficheros()
'Por Dante Amor
' Macro para generar ficheros y envío de correos
'
Application.ScreenUpdating = False
Set h1 = Sheets("Listado")
Set h2 = Sheets("Formato")
Set h3 = Sheets("Temp")
'
ruta = ThisWorkbook.Path & "\"
fecha = Format(Date, "yyyymmdd")
h3.Cells.Clear
'
If h1.AutoFilterMode Then h1.AutoFilterMode = False
u1 = h1.Range("D" & Rows.Count).End(xlUp).Row
h1.Range("D5:G" & u1).Copy h3.Range("A1")
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row
h3.Range("A1:D" & u3).RemoveDuplicates Columns:=1, Header:=xlYes
u3 = h3.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To u3
nombre = h3.Cells(i, "A").Value
correo = h3.Cells(i, "B").Value
ccopia = h3.Cells(i, "D").Value
'
h2.Rows("11:" & Rows.Count).ClearContents
If h1.AutoFilterMode Then h1.AutoFilterMode = False
h1.Range("A5:M" & u1).AutoFilter Field:=4, Criteria1:=nombre
u11 = h1.Range("D" & Rows.Count).End(xlUp).Row
h1.Range("A6:M" & u11).Copy
h2.Range("B11").PasteSpecial xlValues
'
'Generar Pdf
archivo = ruta & fecha & " Pedidos " & nombre & ".pdf"
h3.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=archivo, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'
'Enviar correo
Set dam = CreateObject("Outlook.Application").CreateItem(0)
dam.To = correo 'Destinatarios
dam.Cc = ccopia 'Con copia
dam.Subject = "Valoración de Pedidos" '"Asunto"
cuerpo = h2.Range("B2") & vbCr & _
h2.Range("B3") & vbCr & _
h2.Range("B4") & vbCr & vbCr & _
h2.Range("B6") & vbCr & _
h2.Range("B7")
'
dam.Body = cuerpo '"Cuerpo del mensaje"
dam.Attachments.Add archivo
Dam. Send 'El correo se envía en automático
'dam. Display 'El correo se muestra
Next
If h1.AutoFilterMode Then h1.AutoFilterMode = False
h2.Rows("11:" & Rows.Count).ClearContents
Application.CutCopyMode = False
End SubTe regreso el archivo.
https://www.dropbox.com/s/yrs5qme1d5daccb/Pedido%20lista%20dam.xlsm?dl=0
Ya tiene cuerpo de correo, solamente falta poner en el cuerpo de correo la lista de pedidos, para eso hay que crear una tabla, pero lo podríamos hacer en otra pregunta.
.
.
¡Gracias, eres el mejor !!
Excelente!!!! submito otra pregunta para crear la tabla y aclarar la duda que tengo
Gracias de nuevo !!
