none
VARIAVEL NO ASSUNTO DO EMAIL EXCEL RRS feed

  • Pergunta

  • 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 = "xxxxxxxxxx@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

    sexta-feira, 29 de junho de 2012 13:59

Respostas

  • Usando o código:

    Sub Mail_Selection_Range_CQ()
    ' Don't forget to copy the function RangetoHTML in the module.
    ' Working in Office 2000-2010
        Dim PLANILHA As Worksheet
        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
        Dim Conteúdo As String
        Dim Final As String
        Dim N As Long
        Dim i As Long
    
        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:AG21").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 CQ")
    
        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 & VBA.Trim(PLANILHA.Cells(i, 1)) & Final & vbLf
    
        Next i
    
        On Error Resume Next
        With OutMail
            .To = "anderson.santos@joyglobal.com"
            .CC = ""
            .BCC = ""
            .Subject = "ANÁLISE DE RNC"
            .HTMLBody = Conteúdo + RangetoHTML1(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

    O conteúdo do e-mail mostrado é:

    RNC N° -> 3823 para ser analisado. Segue abaixo os dados do RNC cadastrado 


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 18 de julho de 2012 22:38
    Moderador

Todas as Respostas

  • Troque:

    .Subject = "ANÁLISE DE RNC"
    'por
    Set PLANILHA = Sheets("RNC E-MAIL ENG°")
    .Subject = "ANÁLISE DE RNC " & PLANILHA.Cells(PLANILHA.Rows.Count, 1).End(xlUp).Row


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    sexta-feira, 29 de junho de 2012 18:16
    Moderador
  • Felipe,

    Com o que me pediu para trocar, no assunto do email só aparece: ANÁLISE DE RNC 1.

    Será que deve ser declarada alguma variável mais acima?

    Obirgado, Leonardo.

    segunda-feira, 2 de julho de 2012 11:58
  • Se você quiser, pode usar uma variável.

    Explicação: a expressão

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

    retorna a você o número da última linha povoada na coluna A da Planilha PLANILHA.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 2 de julho de 2012 21:07
    Moderador
  • É Felipe, não onde esta o problema ainda só aparece: ANÁLISE DE RNC 1. 

    terça-feira, 3 de julho de 2012 11:37
  • Disponibilize sua Planilha num site gratuito com sendspace.com e poste o link da sua Pasta de Trabalho aqui.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    terça-feira, 3 de julho de 2012 20:52
    Moderador
  • Felipe,

    Coloquei a planilha no link abaixo:

    http://www.4shared.com/office/voWcwLD-/RELATRIO_DE_NO_CONFORMIDADE_20.html

    Quero que no Assunto do email apareça apareça o número da RNC: ANÁLISE DE RNC xxxx.

    Obrigado, Leonardo.

    quarta-feira, 4 de julho de 2012 18:48
  • Usando o código:

    Sub Mail_Selection_Range_CQ()
    ' Don't forget to copy the function RangetoHTML in the module.
    ' Working in Office 2000-2010
        Dim PLANILHA As Worksheet
        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
        Dim Conteúdo As String
        Dim Final As String
        Dim N As Long
        Dim i As Long
    
        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:AG21").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 CQ")
    
        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 & VBA.Trim(PLANILHA.Cells(i, 1)) & Final & vbLf
    
        Next i
    
        On Error Resume Next
        With OutMail
            .To = "anderson.santos@joyglobal.com"
            .CC = ""
            .BCC = ""
            .Subject = "ANÁLISE DE RNC"
            .HTMLBody = Conteúdo + RangetoHTML1(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

    O conteúdo do e-mail mostrado é:

    RNC N° -> 3823 para ser analisado. Segue abaixo os dados do RNC cadastrado 


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 18 de julho de 2012 22:38
    Moderador