Compartilhar via

VARIAVEL NO ASSUNTO DO EMAIL EXCEL VBA

Anônima
2012-07-02T16:12:54+00:00

Pessoal,

Quero que no Assunto do email apareça apareça o número da RNC como no corpo do email:

  .Subject = "ANÁLISE DE RNC" XXXX por exemplo.

Esse número já existe:  

Set PLANILHA = Sheets("RNC E-MAIL ENG°")

N = PLANILHA.Cells(PLANILHA.Rows.Count, 1).End(xlUp).Row

Abaixo o código que atualmente é utilizado para enviar por email os dados que quero...

Sub Mail_Selection_Range_ENG°()

' Don't forget to copy the function RangetoHTML in the module.

' Working in Office 2000-2010

    Dim rng As Range

    Dim OutApp As Object

    Dim OutMail As Object

    Set rng = Nothing

    On Error Resume Next

    'Only the visible cells in the selection

    Set rng = Selection.SpecialCells(xlCellTypeVisible)

    'You can also use a range if you want

    'DESPROTEGE PLANILHA

    Worksheets("RELATÓRIO").Unprotect "rncp&h"

    Set rng = Sheets("RELATÓRIO").Range("B2:AM64").SpecialCells(xlCellTypeVisible)

    On Error GoTo 0

    If rng Is Nothing Then

        MsgBox "The selection is not a range or the sheet is protected" & _

               vbNewLine & "please correct and try again.", vbOKOnly

        Exit Sub

    End If

    With Application

        .EnableEvents = False

        .ScreenUpdating = False

    End With

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    Set PLANILHA = Sheets("RNC E-MAIL ENG°")

Conteúdo = "RNC N° ->   " & vbTab & vbTab

Final = "    para ser analisado." & vbLf & "Segue abaixo os dados do RNC cadastrado" & vbLf

N = PLANILHA.Cells(PLANILHA.Rows.Count, 1).End(xlUp).Row

   For i = 1 To N

    Conteúdo = Conteúdo & Trim(PLANILHA.Cells(i, 1)) & Final & vbLf

    Next i

    On Error Resume Next

    With OutMail

        .To = "******@zzzzzzzzzzz.ccom"

        .CC = ""

        .BCC = ""

        .Subject = "ANÁLISE DE RNC"

.HTMLBody = Conteúdo + RangetoHTML2(rng)

        .Display

    End With

    On Error GoTo 0

    With Application

        .EnableEvents = True

        .ScreenUpdating = True

    End With

    Set OutMail = Nothing

    Set OutApp = Nothing

    'PROTEGE PLANILHA

Worksheets("RELATÓRIO").Protect "rncp&h", True, True, True

End Sub


Function RangetoHTML2(rng As Range)

' Changed by Ron de Bruin 28-Oct-2006

' Working in Office 2000-2010

    Dim fso As Object

    Dim ts As Object

    Dim TempFile As String

    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in

    rng.Copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)

        .Cells(1).PasteSpecial Paste:=8

        .Cells(1).PasteSpecial xlPasteValues, , False, False

        .Cells(1).PasteSpecial xlPasteFormats, , False, False

        .Cells(1).Select

        Application.CutCopyMode = False

        On Error Resume Next

        .DrawingObjects.Visible = True

        .DrawingObjects.Delete

        On Error GoTo 0

    End With

    'Publish the sheet to a htm file

    With TempWB.PublishObjects.Add( _

         SourceType:=xlSourceRange, _

         Filename:=TempFile, _

         Sheet:=TempWB.Sheets(1).Name, _

         Source:=TempWB.Sheets(1).UsedRange.Address, _

         HtmlType:=xlHtmlStatic)

        .Publish (True)

    End With

    'Read all data from the htm file into RangetoHTML

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

    RangetoHTML2 = ts.ReadAll

    ts.Close

    RangetoHTML2 = Replace(RangetoHTML2, "align=center x:publishsource=", _

                          "align=left x:publishsource=")

    'Close TempWB

    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function

    Kill TempFile

    Set ts = Nothing

    Set fso = Nothing

    Set TempWB = Nothing

End Function

Obrigado

![](http://i3.social.s-msft.com/globalresources/Images/trans.gif?cver=57%0d%0a)

Microsoft 365 e Office | Excel | Para uso doméstico | Windows

Pergunta bloqueada. Essa pergunta foi migrada da Comunidade de Suporte da Microsoft. É possível votar se é útil, mas não é possível adicionar comentários ou respostas ou seguir a pergunta.

0 comentários Sem comentários

Resposta aceita pelo autor da pergunta

Anônima
2012-07-02T17:42:30+00:00

cara, dúvidas de vba são no site abaixo. lá a galera é fera. aki as vezes vem alguém e responde, mas sua questão será respondida mais rápida lah, q eh o fórum específico. vlw!

http://social.msdn.microsoft.com/Forums/pt-br/vbapt/threads

Esta resposta foi útil?

0 comentários Sem comentários

1 resposta adicional

Classificar por: Mais útil
  1. Anônima
    2012-07-02T18:56:17+00:00

    Pois é cara, já procurei e já postei a dúvida lá mais nada me foi respondido ainda.

    Esta resposta foi útil?

    0 comentários Sem comentários