- 12 Dez 2018 às 08:42
#39241
Olá pessoal!
Pesquisei várias e várias formas diferentes de conseguir colocar o conteúdo de células no corpo de e-mail com a formatação da planilha, mas nenhuma delas nunca funcionou.
Outro obstáculo é que algumas linhas no meio da tabela estão ocultas e não podem aparecer no e-mail. O número de linhas ocultas é diferente em cada e-mail que envio.
Para fazer o e-mail eu utilizo a função outmail.htmlbody para utilizar Outllok, não posso mandar o e-mail diretamente pelo Excel.
Achei uma função que até hoje não consegui decifrar o que ela faz,e ela funciona perfeitamente, porém não funciona em casos onde não tenho células ocultas. Outra limitação é que é necessário um intervalo fixo, não podendo utilizar nome de intervalo ou intervalo móvel, já que o intervalo deve ser definido diretamente, por ex: ("A1:B3").
Segue a função abaixo, quem conseguir adaptá-la para o que preciso pode ser mais fácil:
Private Function fncRangeToHtml( _
strWorksheetName As String, _
strRangeAddress As String) As String
Dim objFilesytem As Object, objTextstream As Object, objShape As Shape
Dim strFilename As String, strTempText As String
Dim blnRangeContainsShapes As Boolean
strFilename = Environ$("temp") & "\" & _
Format(Now, "dd-mm-yy_h-mm-ss") & ".htm"
ThisWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=strWorksheetName, _
Source:=strRangeAddress, _
HtmlType:=xlHtmlStatic).Publish True
Set objFilesytem = CreateObject("Scripting.FileSystemObject")
Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)
strTempText = objTextstream.ReadAll
objTextstream.Close
fncRangeToHtml = strTempText
fncRangeToHtml = Replace(fncRangeToHtml, "align=center x:publishsource=", "align=left x:publishsource=")
Set objTextstream = Nothing
Set objFilesytem = Nothing
Kill strFilename
End Function
Public Function fncConvertPictureToMail(strTempText As String, objWorksheet As Worksheet) As String
strTemp = Replace(strTemp, HTM_START & Chr$(34), "")
strTemp = Replace(strTemp, HTM_END & Chr$(34), "")
strTemp = strTemp & "/"
strTempText = Replace(strTempText, strTemp, Environ$("temp") & "" & strTemp)
fncConvertPictureToMail = strTempText
End Function
Pesquisei várias e várias formas diferentes de conseguir colocar o conteúdo de células no corpo de e-mail com a formatação da planilha, mas nenhuma delas nunca funcionou.
Outro obstáculo é que algumas linhas no meio da tabela estão ocultas e não podem aparecer no e-mail. O número de linhas ocultas é diferente em cada e-mail que envio.
Para fazer o e-mail eu utilizo a função outmail.htmlbody para utilizar Outllok, não posso mandar o e-mail diretamente pelo Excel.
Achei uma função que até hoje não consegui decifrar o que ela faz,e ela funciona perfeitamente, porém não funciona em casos onde não tenho células ocultas. Outra limitação é que é necessário um intervalo fixo, não podendo utilizar nome de intervalo ou intervalo móvel, já que o intervalo deve ser definido diretamente, por ex: ("A1:B3").
Segue a função abaixo, quem conseguir adaptá-la para o que preciso pode ser mais fácil:
Private Function fncRangeToHtml( _
strWorksheetName As String, _
strRangeAddress As String) As String
Dim objFilesytem As Object, objTextstream As Object, objShape As Shape
Dim strFilename As String, strTempText As String
Dim blnRangeContainsShapes As Boolean
strFilename = Environ$("temp") & "\" & _
Format(Now, "dd-mm-yy_h-mm-ss") & ".htm"
ThisWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=strWorksheetName, _
Source:=strRangeAddress, _
HtmlType:=xlHtmlStatic).Publish True
Set objFilesytem = CreateObject("Scripting.FileSystemObject")
Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)
strTempText = objTextstream.ReadAll
objTextstream.Close
fncRangeToHtml = strTempText
fncRangeToHtml = Replace(fncRangeToHtml, "align=center x:publishsource=", "align=left x:publishsource=")
Set objTextstream = Nothing
Set objFilesytem = Nothing
Kill strFilename
End Function
Public Function fncConvertPictureToMail(strTempText As String, objWorksheet As Worksheet) As String
strTemp = Replace(strTemp, HTM_START & Chr$(34), "")
strTemp = Replace(strTemp, HTM_END & Chr$(34), "")
strTemp = strTemp & "/"
strTempText = Replace(strTempText, strTemp, Environ$("temp") & "" & strTemp)
fncConvertPictureToMail = strTempText
End Function
