Unlock a world of possibilities! Login now and discover the exclusive benefits awaiting you.
Hola,
comparto con todos el código que usar para mandar mails con las tablas pegadas en el cuerpo del mensaje.
Lo que necesito es que en el html se peguen varias tablas, no solo una, y a poder ser poder insertar el texto que yo quiera entre las tablas.
De momento solo consigo poner una tabla pero necesita unas 4 o 5.
Gracias!!!
MI CODIGO:
'// ****************************************************************
'// Enviador Mails Pegados Cuerpo
'// ****************************************************************
sub SendMail
if Time()>TimeValue("10:15:00") and Time()<TimeValue("21:30:00")Then
' Object creation
Set objMsg = CreateObject("CDO.Message")
Set msgConf = CreateObject("CDO.Configuration")
strDate = CDate(Date)
set cs = ActiveDocument.GetSheetObject("CH80")
cs.ExportHtml "C:\Directory\Pruebas\informe.html"
objMsg.CreateMHTMLBody "file://C:\Directory\Pruebas\informe.html"
' Server Configuration
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "server***********"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mimai********l"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pass******"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
msgConf.Fields.Update
objMsg.To = "mmail***********"
objMsg.From = "mail**********.com"
objMsg.Subject = "Reporte " & Now()
objMsg.Sender = "Reportes"
Set objMsg.Configuration = msgConf
' Send
objMsg.Send
' Clear
Set objMsg = nothing
Set msgConf = nothing
end if
end sub
Not very nice - but it worked.
sub CreateHtmlBodyMail
dim doc, obj, objArr, file, path
dim i
dim vStart, vBetween, vEnd, TempHTML, HtmlContent, fso
set doc = ActiveDocument
path = "D:\"
objArr = array("TB01", "CH01", "CS01")
set fso = CreateObject("Scripting.FileSystemObject")
for i = 0 to ubound(objArr)
set obj = doc.GetSheetObject(objArr(i))
file = "HTML " & i
obj.ExportHtml path & file & ".html"
doc.GetApplication.Sleep 500
set TempHTML = fso.OpenTextFile(path & file & ".html", 1, true)
HtmlContent = TempHTML.readall
if i = 0 then
vStart = mid(HtmlContent, 1, instr(HtmlContent, "<!--EndFragment-->")) & chr(10)
vEnd = chr(10) & mid(HtmlContent, instr(HtmlContent, "<!--EndFragment-->") + 18)
elseif i > 0 then
vBetween = vBetween & mid(HtmlContent, instr(HtmlContent, "<!--StartFragment-->"), instr(HtmlContent, "<!--EndFragment-->") + 18) & chr(10) & chr(10)
end if
TempHTML.close
next
HtmlContent = vStart & vBetween & vEnd
set TempHTML = fso.OpenTextFile(path & "Master.html", 2, true)
TempHTML.write HtmlContent
TempHTML.close
Dim objEmail, config
Set objEmail = CreateObject("CDO.Message")
config = "http://schemas.microsoft.com/cdo/configuration/"
objEmail.Configuration.Fields.Item(config & "sendusing") = 2 'http://msdn.microsoft.com/en-us/library/exchange/ms873037%28v=exchg.65%29.aspx
objEmail.Configuration.Fields.Item(config & "smtpserver") = "YourMailServer" 'Name or IP of Remote SMTP Server
objEmail.Configuration.Fields.Item(config & "smtpserverport") = 25 'Server port (typically 25)
objEmail.Configuration.Fields.Item(config & "smtpusessl") = False 'Use SSL for the connection (False or True)
objEmail.Configuration.Fields.Item(config & "smtpconnectiontimeout") = 60 'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objEmail.Configuration.Fields.Update 'End remote SMTP server configuration section
objEmail.From = "YourFrom"
objEmail.To = "YourTo"
objEmail.Subject = "E-Mail with HTML-Body with embedded QV-Objects"
objEmail.CreateMHTMLBody "file://" & path & "Master.html"
objEmail.Send
end sub
- Marcus
Create a cycle.
Con esto ya lo soluciono todo....
Directly with qv-functionalities it's only possible to export one object after another to html. So it seems that the only way is to manipulate the html. Maybe with the following main-logic:
- export all your wished objects to html (in a certain order?)
- open the first one (as master)
set fso = CreateObject("Scripting.FileSystemObject")
set HtmlFile = fso.OpenTextFile("D:\Path\File.html", 2, true)
HtmlContent= HtmlFile.readall
- split this by <!--EndFragment--> into two pieces (vStart & vEnd)
- open the next file
- cut the area from <!--StartFragment--> to <!--EndFragment--> into a variable (vBetween)
- put the variables together and write it in this or a new file + save & close
HtmlFile.write vStart & vBetween & vEnd
HtmlFile.close
It's not very beautiful but I hope it worked.
- Marcus
Thanks but.... Can you write it in my code?
set cs = ActiveDocument.GetSheetObject("CH80")
cs.ExportHtml "C:\Directory\Pruebas\informe.html"
.... your another objects ... maybe exported in a loop ...
set fso = CreateObject("Scripting.FileSystemObject")
set HtmlFile = fso.OpenTextFile("D:\Path\File.html", 2, true)
HtmlContent= HtmlFile.readall
split HtmlContent into the variables per left/right/mid with instr(HtmlContent, "<!--StartFragment-->")
open the next export-file and cut this table with the same method
put all together and write it within the txt-file and save it and then
objMsg.CreateMHTMLBody "file://C:\Directory\Pruebas\informe.html"
- Marcus
'// ****************************************************************
'// Enviador Mails Pegados Cuerpo
'// ****************************************************************
sub SendMail
if Time()>TimeValue("10:15:00") and Time()<TimeValue("21:30:00")Then
' Object creation
Set objMsg = CreateObject("CDO.Message")
Set msgConf = CreateObject("CDO.Configuration")
strDate = CDate(Date)
set cs = ActiveDocument.GetSheetObject("CH80")
cs.ExportHtml "C:\Directory\Pruebas\informe.html"
set fso = CreateObject("Scripting.FileSystemObject")
set HtmlFile = fso.OpenTextFile("D:\Path\File.html", 2, true)
HtmlContent= HtmlFile.readall
objMsg.CreateMHTMLBody "file://C:\Directory\Pruebas\informe.html"
' Server Configuration
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "server***********"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mimai********l"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pass******"
msgConf.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
msgConf.Fields.Update
objMsg.To = "mmail***********"
objMsg.From = "mail**********.com"
objMsg.Subject = "Reporte " & Now()
objMsg.Sender = "Reportes"
Set objMsg.Configuration = msgConf
' Send
objMsg.Send
' Clear
Set objMsg = nothing
Set msgConf = nothing
end if
end sub
Can you continue? i don't know how i ican do it.
Thank you very much
Not very nice - but it worked.
sub CreateHtmlBodyMail
dim doc, obj, objArr, file, path
dim i
dim vStart, vBetween, vEnd, TempHTML, HtmlContent, fso
set doc = ActiveDocument
path = "D:\"
objArr = array("TB01", "CH01", "CS01")
set fso = CreateObject("Scripting.FileSystemObject")
for i = 0 to ubound(objArr)
set obj = doc.GetSheetObject(objArr(i))
file = "HTML " & i
obj.ExportHtml path & file & ".html"
doc.GetApplication.Sleep 500
set TempHTML = fso.OpenTextFile(path & file & ".html", 1, true)
HtmlContent = TempHTML.readall
if i = 0 then
vStart = mid(HtmlContent, 1, instr(HtmlContent, "<!--EndFragment-->")) & chr(10)
vEnd = chr(10) & mid(HtmlContent, instr(HtmlContent, "<!--EndFragment-->") + 18)
elseif i > 0 then
vBetween = vBetween & mid(HtmlContent, instr(HtmlContent, "<!--StartFragment-->"), instr(HtmlContent, "<!--EndFragment-->") + 18) & chr(10) & chr(10)
end if
TempHTML.close
next
HtmlContent = vStart & vBetween & vEnd
set TempHTML = fso.OpenTextFile(path & "Master.html", 2, true)
TempHTML.write HtmlContent
TempHTML.close
Dim objEmail, config
Set objEmail = CreateObject("CDO.Message")
config = "http://schemas.microsoft.com/cdo/configuration/"
objEmail.Configuration.Fields.Item(config & "sendusing") = 2 'http://msdn.microsoft.com/en-us/library/exchange/ms873037%28v=exchg.65%29.aspx
objEmail.Configuration.Fields.Item(config & "smtpserver") = "YourMailServer" 'Name or IP of Remote SMTP Server
objEmail.Configuration.Fields.Item(config & "smtpserverport") = 25 'Server port (typically 25)
objEmail.Configuration.Fields.Item(config & "smtpusessl") = False 'Use SSL for the connection (False or True)
objEmail.Configuration.Fields.Item(config & "smtpconnectiontimeout") = 60 'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
objEmail.Configuration.Fields.Update 'End remote SMTP server configuration section
objEmail.From = "YourFrom"
objEmail.To = "YourTo"
objEmail.Subject = "E-Mail with HTML-Body with embedded QV-Objects"
objEmail.CreateMHTMLBody "file://" & path & "Master.html"
objEmail.Send
end sub
- Marcus
You are the MASTER. Thank you very much
Hello again!
Before writing the second table in the html file a sign "< " appears
How I can remove it?
Thanks!!!