Vídeo recomendado
https://youtu.be/diWPPPhW-9E

Alterar nome da Sheet e Anexar no Outlook

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Avatar do usuário
cy_rangel
Colaborador
Colaborador
Mensagens: 88
Registrado em: Sex Set 04, 2015 8:32 pm

Alterar nome da Sheet e Anexar no Outlook

Mensagem por cy_rangel »

Olá pessoal,

Gostaria de uma ajuda!

Tenho um código pronto que salva apenas 1 aba especifica do excel, remomeia e anexa apenas essa aba no e-mail.

O que gostaria é renomear essa aba ("Parcela") sem que seja com o próprio nome da Sheet mas sim com o da célula A2 (por exemplo).

Conseguem me ajudar, por favor?

Segue o código que estou utilizando:

Código: Selecionar todos

Sub EnviarEmailOutlook()
    
 Application.ScreenUpdating = False 'Não piscar a tela ao executar a macro


 ' Enviar Email
 ' fote: http://excelribbon.tips.net/T008508_Sending_Single_Worksheets_via_E-mail.html
    
    Dim oApp As Object
    Dim oMail As Object
    Dim WB As Workbook
    Dim FileName As String
       
    Application.ScreenUpdating = False

    Sheets("Parcela").Select
    ActiveSheet.Copy
    Set WB = ActiveWorkbook

    FileName = WB.Worksheets("Parcela").Name 'Nome da Sheet
    On Error Resume Next
    Kill ThisWorkbook.Path & "\" & FileName
    On Error GoTo 0
    WB.SaveAs FileName:=ThisWorkbook.Path & "\" & FileName 'Salva com o nome da Sheet, gostaria de alterar para salvar o arquivo com a informação da célula "A2"
    
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
            
    With oMail
         .SentOnBehalfOfName = ("teste@teste.com")
         .Subject = "Parcela - " & Range("A2").Value
         .Body = "Prezados(as)," & vbNewLine & vbNewLine & Saudacao & vbNewLine & vbNewLine _
                 & "Segue anexo..." & vbNewLine & vbNewLine _
         
         .Attachments.Add WB.FullName
         .Display
        
    End With

    ' deleta o arquivo temporario
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False
   
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
    
     Sheets("TD_Enviar").Select
     
     
Application.ScreenUpdating = True 'Não piscar a tela ao executar a macro
     
End Sub

Function Saudacao() As String
'**********************************************************************
'Função que define a saudação correta de acordo com o horário
'**********************************************************************

    Select Case Time
        Case Is < "12:00:00"
            Saudacao = "Bom-dia."
        Case Is < "18:00:00"
            Saudacao = "Boa-tarde."
        Case Else
            Saudacao = "Boa-noite."
    End Select

End Function

Desde já agradeço.


Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder