Skip to main content
Announcements
Have questions about Qlik Connect? Join us live on April 10th, at 11 AM ET: SIGN UP NOW
cancel
Showing results for 
Search instead for 
Did you mean: 
Not applicable

Exportar varias tablas a un archivo html

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 

' Email 

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

1 Solution

Accepted Solutions
marcus_sommer

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

View solution in original post

30 Replies
Anonymous
Not applicable
Author

Create a cycle.

Not applicable
Author

Con esto ya lo soluciono todo....

marcus_sommer

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

Not applicable
Author

Thanks but.... Can you write it in my code?

marcus_sommer

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

Not applicable
Author

'// ****************************************************************

'// 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

' Email

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

marcus_sommer

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

Not applicable
Author

You are the MASTER. Thank you very much

Not applicable
Author

Hello again!

Before writing the second table in the html file a sign "< " appearschar.JPG

How I can remove it?

Thanks!!!