Hola a todos, soy nuevo en el foro. Quisiera ver si me puede ayudar.
Actualmente trabajo en call center y tengo que enviar reportes estadisticos. Ya logre hacer la generacion de los repotes y en el envio masivo.
solo me falta el poder enviar imagenes en el cuerpo del correo y poner firma en RTF, esto hasta el momento no lo he podido hacer ¿Alguien me puede ayudar? Se los agradecer mucho.
Este el codigo del envío
Sub Envio()
Application.ScreenUpdating = False
'Declaracion de Dim's
Dim acc As Object
Dim dns As Object
Dim ruta As String
Dim rutaLiga As String
Dim Zerato As Object
Dim OutApp As Object
Dim OutMail As Object
Dim fso As Object
Dim ts As Object
Dim strbody As String
Dim ruta As String
Dim Firma As String
Application.DisplayAlerts = False
'Asignar Valores
Z = 0
ruta = "C:\Documents and Settings\mario.vera\Mis documentos\"
Hola a todos, soy nuevo en el foro. Quisiera ver si me puede ayudar.
Actualmente trabajo en call center y tengo que enviar reportes estadisticos. Ya logre hacer la generacion de los repotes y en el envio masivo.
solo me falta el poder enviar imagenes en el cuerpo del correo y poner firma en RTF, esto hasta el momento no lo he podido hacer ¿Alguien me puede ayudar? Se los agradecer mucho.
Este el codigo del envío
Sub Envio()
Application.ScreenUpdating = False
'Declaracion de Dim's
Dim acc As Object
Dim dns As Object
Dim ruta As String
Dim rutaLiga As String
Dim Zerato As Object
Dim OutApp As Object
Dim OutMail As Object
Dim fso As Object
Dim ts As Object
Dim strbody As String
Dim ruta As String
Dim Firma As String
Application.DisplayAlerts = False
'Asignar Valores
Z = 0
ruta = "C:\Documents and Settings\mario.vera\Mis documentos\"
rutaLiga = "http://10.252.195.26/TPK/Seiya/Reportes/Retro/"
Set Zer = Sheets("Fechas").Range("B3")
'Hacer mientras sea diferente que el 1er Set a valga nada
Do While Zer.Offset(Z, 0) <> ""
'Valor de Fecha
Fecha = Zer.Offset(Z, 0)
'Valor de Mes y dia para la creacion de archivo de la liga
mes = Format(Zer.Offset(Z, 0), "MMM")
dia = Format(Day(Zer.Offset(Z, 0)), "00")
Valida_dia = Format(Zer.Offset(Z, 0), "dddd")
'Para mes anterior
Fecha_mes_anterior = Fecha - 1
Mes_anterior = Format(Fecha_mes_anterior, "MMM")
dia_anterior = Format(Day(Fecha_mes_anterior), "00")
Mes_anterior2 = Format(Fecha_mes_anterior, "M")
'Creacion de conexion
Set dns = CreateObject("ADODB.Connection")
dns.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ruta & "Datos.mdb" & ";Persist Security Info=False"
dns.Open
Set acc = CreateObject("ADODB.Recordset")
Sql = "SELECT * FROM Datos_SD"
acc.Open Sql, dns
acc.MoveFirst
Do While acc.EOF = False 'Hacer hasta que el recorrido de Access sea null
'Declaracion de Valores para Access
campaña = acc.fields("Campaña") 'Campaña
Apli = acc.fields(1) 'Apli
Hora_Ini = acc.fields(2) 'Hora_Ini_Real
Hora_Fin = acc.fields(4) 'Hora_Fin_Real
Hora_Ini2 = acc.fields(3) 'Hora_Ini_Para_Celdas
Hora_Fin2 = acc.fields(6) 'Hora_fin_Para_Celdas
Hora_Media_Adela = acc.fields(5) 'Hora_fin_Media_Adelante
ACCM = acc.fields(7) 'ACM Responsable
MetaSL = acc.fields(8) 'Meta Nivel de Serivicio
MetaOCCY = acc.fields(9) 'Meta Occupancy
NomCampaña = acc.fields(10) 'Nombre de Campaña Real
destinatarios = acc.fields(11) 'Nombre de Campaña Real
'Correo
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set OutMail = OutApp.CreateItem(0)
strbody = "Buen día," & vbNewLine & _
"Anexo los reportes a día vencido" & vbNewLine & _
ruta = "C:\Documents and Settings\mario.vera\Datos de programa\Microsoft\Firmas\Firma.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(ruta).OpenAsTextStream(1, -2)
Firma = ts.readall
ts.Close
On Error Resume Next
With OutMail
.To = destinatarios
.CC = ""
.BCC = ""
.Subject = "ACD| Reporte " & NomCampaña & " APL " & Apli & " al día " & dia & " de " & mes
.Body strbody & vbNewLine & vbNewLine & Firma
.Attachments.Add "C:\Documents and Settings\mario.vera\Mis documentos\Nuevos Reportes\" & campaña & "\" & Apli & "\" & mes & "\" & campaña & "_" & dia & "_" & mes & ".xls"
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
acc.MoveNext
Loop 'Cierre mientras es igual a vacio
Z = Z + 1
Loop 'Cierre de Zer Valga Nada
End Sub