Note: The other languages of the website are Google-translated. Back to English

Como inserir a assinatura do Outlook ao enviar e-mail no Excel?

Supondo que você queira enviar um e-mail diretamente no Excel, como você pode adicionar a assinatura padrão do Outlook ao e-mail? Este artigo fornece dois métodos para ajudá-lo a adicionar assinatura do Outlook ao enviar e-mail no Excel.

Insira a assinatura no e-mail do Outlook ao enviar pelo Excel VBA
Insira facilmente a assinatura do Outlook ao enviar e-mail no Excel com uma ferramenta incrível

Mais tutoriais para enviar em Excel ...


Insira a assinatura no e-mail do Outlook ao enviar pelo Excel VBA

Por exemplo, há uma lista de endereços de e-mail em uma planilha e você precisa enviar um e-mail para todos esses endereços no Excel e incluir a assinatura padrão do Outlook em todos os e-mails. Por favor, aplique o código VBA abaixo para obtê-lo.

1. Abra a planilha que contém a lista de endereços de e-mail para a qual deseja enviar um e-mail e pressione o botão outro + F11 chaves.

2. Na abertura Microsoft Visual Basic para Aplicações janela, clique em inserção > Módulo, e copie o abaixo VBA 2 na janela de código do módulo.

3. Agora você precisa substituir o .Corpo linha em VBA 2 com o código em VBA 1. Depois disso, corte o .Exibição linha e cole-o sob o Com xMailOut linha.

VBA 1: Modelo de envio de email com assinatura em Excel

.HTMLBody = "This is a test email sending in Excel" & "<br>" & .HTMLBody

VBA 2: enviar e-mail para endereços de e-mail especificados em células no Excel

Sub SendEmailToAddressInCells()
    Dim xRg As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
    For Each xRgEach In xRg
        xRgVal = xRgEach.Value
        If xRgVal Like "?*@?*.?*" Then
            Set xMailOut = xOutApp.CreateItem(olMailItem)
            With xMailOut
                .To = xRgVal
                .Subject = "Test"
                .Body = "Dear " _
                      & vbNewLine & vbNewLine & _
                        "This is a test email " & _
                        "sending in Excel"
                .Display
                '.Send
            End With
        End If
    Next
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub

A captura de tela a seguir pode ajudá-lo a encontrar facilmente as diferenças após alterar o código do VBA.

4. aperte o F5 chave para executar o código. Então uma Kutools for Excel selecione a caixa pop-up, selecione os endereços de e-mail para os quais enviará e-mails e clique em OK.

Em seguida, emails enviados para endereços específicos são criados e exibidos. Você pode ver que a assinatura padrão do Outlook foi adicionada ao final do corpo do e-mail.

Dicas:

  • 1. Você pode alterar o corpo do e-mail no código VBA 1 com base em suas necessidades.
  • 2. Depois de executar o código, se uma caixa de diálogo de erro aparecer avisando que o tipo definido pelo usuário não foi definido, feche esta caixa de diálogo e clique em Ferramentas > Referências no Microsoft Visual Basic para Aplicações janela. Na abertura Referências - VBAProject janela, verifique o Biblioteca de objetos do Microsoft Outlook caixa e clique OK. E então execute o código novamente.

Insira facilmente a assinatura do Outlook ao enviar e-mail no Excel com uma ferramenta incrível

Se você é um novato no VBA, aqui recomendo fortemente o Mande emails utilidade de Kutools for Excel para voce. Com esse recurso, você pode enviar e-mails facilmente com base em determinados campos do Excel e adicionar assinatura do Outlook a eles. Faça o seguinte.

Antes de aplicar Kutools for Excel, Por favor baixe e instale primeiro.

Em primeiro lugar, você precisa criar uma lista de e-mails com diferentes campos nos quais enviará e-mails.

Você pode criar manualmente uma lista de e-mails conforme sua necessidade ou aplicar o recurso Criar lista de e-mails para fazer isso rapidamente.

1. Clique Kutools Plus > Crie uma lista de mala direta.

2. No Criar lista de discussão caixa de diálogo, especifique os campos que você precisa, escolha onde a lista de saída e, em seguida, clique no OK botão.

3. Agora, uma amostra de lista de mala direta é criada. Como é uma lista de amostra, você precisa alterar os campos para determinados conteúdos necessários. (várias linhas são permitidas)

4. Depois disso, selecione toda a lista (incluir cabeçalhos), clique em Kutools Plus > Mande emails.

5. No Mande emails caixa de diálogo:

  • 5.1) Os itens da lista de discussão selecionada são colocados nos campos correspondentes automaticamente;
  • 5.2) Concluir o corpo do email;
  • 5.3) Verifique os Enviar e-mail via Outlook e Use as configurações de assinatura do Outlook caixas;
  • 5.4) Clique no ENVIAR botão. Veja a imagem:

Agora os emails são enviados. E a assinatura padrão do Outlook é adicionada ao final do corpo do e-mail.

  Se você quiser ter um teste gratuito (30 dias) deste utilitário, por favor clique para fazer o downloade, em seguida, aplique a operação de acordo com as etapas acima.


Artigos relacionados:

Enviar e-mail para endereços de e-mail especificados nas células do Excel
Suponha que você tenha uma lista de endereços de e-mail e queira enviar mensagens em massa para esses endereços de e-mail diretamente no Excel. Como fazer isso? Este artigo mostrará os métodos de envio de e-mail para vários endereços de e-mail especificados nas células do Excel.

Enviar e-mail copiando e colando um intervalo especificado no corpo do e-mail no Excel
Em muitos casos, um intervalo especificado de conteúdo na planilha do Excel pode ser útil em sua comunicação por email. Neste artigo, apresentaremos um método de envio de e-mail com intervalo especificado colado no corpo do e-mail diretamente no Excel.

Envie e-mail com vários anexos anexados no Excel
Este artigo fala sobre como enviar um e-mail pelo Outlook com vários anexos anexados no Excel.

Enviar e-mail se a data de vencimento for cumprida no Excel
Por exemplo, se a data de vencimento na coluna C for menor ou igual a 7 dias (a data atual é 2017/9/13), envie um lembrete por e-mail para o destinatário especificado na coluna A com o conteúdo especificado na coluna B. Como consiga? Este artigo fornecerá um método VBA para lidar com isso em detalhes.

Enviar e-mail automaticamente com base no valor da célula no Excel
Suponha que você queira enviar um e-mail através do Outlook para um determinado destinatário com base em um valor de célula especificado no Excel. Por exemplo, quando o valor da célula D7 em uma planilha é maior que 200, um e-mail é criado automaticamente. Este artigo apresenta um método VBA para você resolver rapidamente esse problema.

Mais tutoriais para enviar em Excel ...


As melhores ferramentas de produtividade para escritório

O Kutools for Excel resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Barra Super Fórmula (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2019 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Teste gratuito de 30 dias com recursos completos. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Guia do Office traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
parte inferior da aba do escritório
Comentários (27)
Ainda não há classificações. Seja o primeiro a avaliar!
Este comentário foi feito pelo moderador no site
muito obrigado, você salvou minha vida com este template :D
Este comentário foi feito pelo moderador no site
Caro Fávio,
Feliz em ajudar.
Este comentário foi feito pelo moderador no site
não funciona com anexos no Office 2016
Este comentário foi feito pelo moderador no site
Querido Chris,
O código VBA abaixo pode ajudá-lo. Depois de executar o código, selecione as células que contêm os endereços de e-mail para os quais você enviará e-mails e, em seguida, selecione os arquivos que você precisa anexar no e-mail como anexos quando a segunda caixa de diálogo aparecer. E a assinatura padrão do Outlook também será exibida no corpo do email. Obrigado pelo seu comentário.

Sub SendEmailToAddressInCells()
Dim xRg como intervalo
Dim xRgEach As Range
Dim xRgVal As String
Dim xAddress As String
Dim xOutApp As Outlook.Application
Dim xMailOut As Outlook.MailItem
On Error Resume Next
xAddress = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Por favor, selecione o intervalo de endereços de e-mail", "KuTools For Excel", xAddress, , , , , 8)
Se xRg não for nada, saia do sub
Application.ScreenUpdating = False
Set xOutApp = CreateObject("Outlook.Application")
Definir xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
Definir xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
Se xFileDlg.Show = -1 Então
Para cada xRgEach Em xRg
xRgVal = xRgEach.Value
Se xRgVal Gostar de "?*@?*.?*" Então
Definir xMailOut = xOutApp.CreateItem(olMailItem)
Com xMailOut
.Exibição
.Para = xRgVal
.Assunto = "Teste"
.HTMLBody = "Este é um e-mail de teste enviado em Excel" & "
" & .HTMLBody
Para cada xFileDlgItem em xFileDlg.SelectedItems
.Anexos.Adicionar xFileDlgItem
Próximo xFileDlgItem
'.Mandar
Terminar com
Se acabar
Seguinte
Definir xMailOut = Nada
Definir xOutApp = Nada
Application.ScreenUpdating = True
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
estou tentando adicionar a assinatura do Outlook intitulada "padrão", mas não parece que funcione.
Você pode por favor ajudar? Acredito que minha lógica "xMailout" esteja errada. esta é a minha área defeituosa suspeita.

Sub CommandButton1_Click () particular

Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Dim xMailOut As Outlook.MailItem
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Saudações:" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2" & vbNewLine & _
"Esta é a linha 3" & vbNewLine & _
"Esta é a linha 4"
On Error Resume Next
Com xOutMail
.To = "Email.aqui.com"
.CC = "E-mail.aqui.com"
.Subject = "Título do e-mail aqui - " & Range("Cell#").value
.Body = xMailBody
. Attachments.Add ActiveWorkbook.FullName
Definir xMailOut = xOutApp.CreateItem(olMailItem)
Com xMailOut
.Exibição
Terminar com
ActiveWorkbook.Save
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
Dia bom,
Seu script foi modificado, por favor, tente. Obrigada.

Sub CommandButton1_Click () particular
Dim xOutApp como objeto
Dim xOutMail como objeto
Dim xMailBody As String
Dim xMailOut As Outlook.MailItem
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Definir xOutMail = xOutApp.CreateItem(0)
xMailBody = "Saudações:" & vbNewLine & vbNewLine & _
"Esta é a linha 1" & vbNewLine & _
"Esta é a linha 2" & vbNewLine & _
"Esta é a linha 3" & vbNewLine & _
"Esta é a linha 4"
On Error Resume Next
Com xOutMail
.To = "Email.aqui.com"
.CC = "E-mail.aqui.com"
.Subject = "Título do email aqui - " & Range("Cell#").Value
.Body = xMailBody
.Attachments.Add ActiveWorkbook.FullName
Definir xMailOut = xOutApp.CreateItem(olMailItem)
Com xMailOut
.Exibição
Terminar com
Terminar com
ActiveWorkbook.Save
Em erro GoTo 0
Definir xOutMail = Nada
Definir xOutApp = Nada
End Sub
Este comentário foi feito pelo moderador no site
como adicionar assinatura se a macro for usada por vários usuários.
por exemplo, minha macro será executada por 3 outras pessoas também. Então, como a macro pode usar a assinatura do usuário que está executando a macro.
desde já, obrigado
Este comentário foi feito pelo moderador no site
Bom dia,
O código VBA pode reconhecer automaticamente a assinatura padrão no Outlook do remetente e enviar e-mail com sua própria assinatura pelo Outlook.
Este comentário foi feito pelo moderador no site
Se meu texto do corpo estiver vinculado a extrair de campos do Excel, o uso de & .HTMLBody no final da string apaga todo o texto do corpo e apenas deixa a assinatura.
Este comentário foi feito pelo moderador no site
Estou tendo problemas para executar isso no Excel 2016. Recebo uma mensagem "Erro de compilação: Tipo definido pelo usuário não definido". Por favor ajude!
Este comentário foi feito pelo moderador no site
Excelente!!!!
Este comentário foi feito pelo moderador no site
Muito obrigado ...
Este comentário foi feito pelo moderador no site
Oi, eu precisaria de ajuda com minha macro, preciso inserir a assinatura do Outlook embaixo da mesa, você poderia me ajudar com isso?

Sub CommandButton1_Click () particular


Perspectiva fraca como objeto
Escurecer novoE-mail como objeto
Escurecer xInspecionar como objeto
Dim pageEditor As Object

Set outlook = CreateObject("Outlook.Application")
Definir novoEmail = outlook.CreateItem(0)

Com novoE-mail
.To = Sheet5.Range("F1")
.CC = ""
.BCC = ""
.Assunto = Sheet5.Range("B5")
.Body = Sheet5.Range("B41")
.mostrar

Definir xInspect = newEmail.GetInspector
Definir pageEditor = xInspect.WordEditor

Sheet5.Range("B6:I7").Copy

pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

.mostrar
Definir pageEditor = Nada
Definir xInspect = Nada
Terminar com

Definir novoEmail = Nada
Definir perspectiva = Nada

End Sub
Este comentário foi feito pelo moderador no site
Olá Bara,
Desculpe não poder ajudá-lo com isso. Obrigado por seu comentário.
Este comentário foi feito pelo moderador no site
Caro,
Alguém pode me ajudar com meu VBA,
Preciso da assinatura no email criado:
Este comentário foi feito pelo moderador no site
Graças a você, posso adicionar assinatura agora, mas remove os espaços entre os parágrafos do texto. Por favor você pode me ajudar ?


Sub helloworld()
Dim OutApp As Object
Dim OutMail As Object
Escurecer célula como intervalo
Dim Path As String
Caminho = Application.ActiveWorkbook.Path
Set OutApp = CreateObject("Outlook.Application")

Para cada célula no intervalo("C4:C6")
Set OutMail = OutApp.CreateItem(0)
Com o OutMail
.Exibição
.Para = célula.Valor
.Assunto = Células(célula.Linha, "D").Valor
.HTMLBody = "Prezado " & Cells(cell.Row, "B").Value & "," _
& vbNewLine & vbNewLine & _
"Calorosas saudações" _
& vbNewLine & vbNewLine & _
"Nós, JK Overseas, gostaríamos de aproveitar a oportunidade e apresentar nossa empresa JK Overseas, que está envolvida no negócio de sal nos últimos 3 anos. Atualmente somos fortes no mercado doméstico e em expansão no exterior. Somos o fornecedor de Sal Comestível, Sal amaciador de água, sal descongelante, sal industrial" e "." _
& vbNewLine & vbNewLine & _
"Temos um vínculo com fabricantes de grande escala na Índia e adquirimos sal de qualidade e exportações. Portanto, estamos procurando um importador especializado confiável, bem como um agente distribuidor para fazer um negócio de longo prazo com benefício mútuo" & " ." _
& vbNewLine & vbNewLine & _
"Por favor, entre em contato conosco com sua necessidade ou para qualquer outra dúvida que você possa ter. Nós fornecemos logística confiável e entrega no prazo. Estamos confiantes de que nossos preços, sendo os mais competitivos, atenderão às suas expectativas" & "." _
& vbNewLine & vbNewLine & _
.HTMLBody

'.Mandar
Terminar com
Próxima célula
End Sub
Este comentário foi feito pelo moderador no site
Estou tentando integrar este código no formato atual que tenho atualmente, pelo qual posso automatizar e-mails no Excel com base em um intervalo definido de valores. Qualquer ajuda em relação a onde adicionar o código 'assinatura' dentro do que tenho atualmente seria muito apreciada.

Public Sub CheckAndSendMail()

'Atualizado por Extendoffice 2018/11/22

Dim xRgDate como intervalo

Dim xRgSend As Range

Dim xRgText como intervalo

Dim xRgDone As Range

Dim xOutApp como objeto

Dim xMailItem como objeto

Dim xLastRow Tão Longo

Dim vbCrLf As String

Dim xMailBody As String

Dim xRgDateVal como string

Dim xRgSendVal As String

Dim xMailSubject As String

Escurecer eu enquanto

On Error Resume Next

'Por favor, especifique o intervalo de datas de vencimento

xStrRang = "D2:D110"

Definir xRgDate = Range(xStrRang)

'Por favor, especifique o intervalo de endereços de e-mail do destinatário

xStrRang = "C2:C110"

Definir xRgSend = Range(xStrRang)

xStrRang = "A2:A110"

Definir xRgName = Range(xStrRang)

'Especifique o intervalo com conteúdo lembrado em seu e-mail

xStrRang = "Z2:Z110"

Definir xRgText = Range(xStrRang)

xLastRow = xRgDate.Rows.Count

Definir xRgDate = xRgDate(1)

Definir xRgSend = xRgSend(1)

Definir xRgName = xRgName(1)

Definir xRgText = xRgText(1)

Set xOutApp = CreateObject("Outlook.Application")

Para I = 1 Para xLastRow

xRgDateVal = ""

xRgDateVal = xRgDate.Offset(I - 1).Value

Se xRgDateVal <> "" Então

If CDate(xRgDateVal) - Data <= 30 E CDate(xRgDateVal) - Data > 0 Then

xRgSendVal = xRgSend.Offset(I - 1).Value

xMailSubject = " Contrato de serviço JBC expirando em " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

xMailBody = xMailBody & "Caro " & xRgName.Offset(I - 1).Value & vbCrLf

xMailBody = xMailBody & " " & xRgText.Offset(I - 1).Value & vbCrLf

xMailBody = xMailBody & ""

Definir xMailItem = xOutApp.CreateItem(0)

Com xMailItem

.Assunto = xMailAssunto

.Para = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.Exibição

'.Mandar

Terminar com

Definir xMailItem = Nada

Se acabar

Se acabar

Seguinte

Definir xOutApp = Nada

End Sub
Este comentário foi feito pelo moderador no site
É um código realmente útil
Eu preciso mudar o formato do texto da direita para a esquerda Na linha xOutMsg
ajuda por favor .
Este comentário foi feito pelo moderador no site
Estou tentando enviar planilhas individuais do Excel para e-mails diferentes, mas ele só anexará a própria pasta de trabalho. Além disso, preciso ser capaz de adicionar minha linha de assinatura. Qualquer ajuda?Sub AST_Email_From_Excel()

Dim emailApplication As Object
Dim emailItem As Object

Set emailApplication = CreateObject("Outlook.Application")
Definir emailItem = emailApplication.CreateItem(0)

' Agora nós construímos o e-mail.

emailItem.to = Range("e2").Value

emailItem.CC = Range("g2").Value

emailItem.Subject = "Equipamento de Techquidation não devolvido"

emailItem.Body = "Veja a planilha anexada para itens não devolvidos em sua área"

'Anexa a pasta de trabalho atual
emailItem.Attachments.Add ActiveWorkbook.FullName

'Anexe qualquer arquivo do seu computador.
'emailItem.Attachments.Add ("C:\...)"

'Envia o e-mail
'emailItem.send

'Exibe o email para que o usuário possa alterá-lo conforme desejar antes de enviar
emailItem.Display

Definir emailItem = Nada
Definir emailApplication = Nothing

End Sub
Este comentário foi feito pelo moderador no site
Oi Chris, O código que você forneceu foi modificado. A assinatura do Outlook agora pode ser inserida no corpo da mensagem. Por favor, tente. Obrigada. Sub AST_Email_From_Excel()
'Atualizado por Extendoffice 20220211
Dim emailApplication As Object
Dim emailItem As Object
Set emailApplication = CreateObject("Outlook.Application")
Definir emailItem = emailApplication.CreateItem(0)

' Agora nós construímos o e-mail.
emailItem.Display 'Exibe o email para que o usuário possa alterá-lo conforme desejar antes de enviar
emailItem.to = Range("e2").Value
emailItem.CC = Range("g2").Value
emailItem.Subject = "Equipamento de Techquidation não devolvido"
emailItem.HTMLBody = "Veja a planilha anexada para itens não devolvidos em sua área" & " " & emailItem.HTMLBody

'Anexa a pasta de trabalho atual
emailItem.Attachments.Add ActiveWorkbook.FullName

Definir emailItem = Nada
Definir emailApplication = Nothing

End Sub
Este comentário foi feito pelo moderador no site
Oi Crystal, Obrigado por adicionar a assinatura, mas não parece gostar da seção HTMLBody. Quando executo a macro, ela depura em emailItem.HTMLBody = "Veja a planilha anexada para itens não devolvidos em sua área" & " " & emailItem.HTMLBodyand não completa o resto.  
Este comentário foi feito pelo moderador no site
Oi,
Qual versão do Excel você está usando? O código VBA a seguir também pode ajudar. Por favor, tente. Obrigado pelo seu feedback! Sub EnviarPlanilha()
'Atualizar por Extendoffice 20220218
Dim xFile As String
Dim xFormat por muito tempo
Dim Wb como pasta de trabalho
Dim Wb2 como pasta de trabalho
Dim FilePath As String
Dim FileName As String
Dim OutlookApp como objeto
Dim OutlookMail As Object
On Error Resume Next
Application.ScreenUpdating = False
Definir Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Definir Wb2 = Application.ActiveWorkbook
Selecionar caso Wb.FileFormat
Caso xlOpenXMLWorkbook:
xArquivo = ".xlsx"
xFormat = xlOpenXMLWorkbook
Caso xlOpenXMLWorkbookMacroEnabled:
Se Wb2.HasVBProject Então
xArquivo = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Outro
xArquivo = ".xlsx"
xFormat = xlOpenXMLWorkbook
Se acabar
Caso Excel8:
xArquivo = ".xls"
xFormato = Excel8
Caso xlExcel12:
xArquivo = ".xlsb"
xFormato = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Agora, "dd-mmm-aa h-mm-ss")
Set OutlookApp = CreateObject("Outlook.Application")
Definir OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
'xstr = Range("e2") & " ; " & Range("g2")
Com Outlook Mail
.Exibição
.To = Range("e2")
.CC = Range("g2")
.BCC = ""
.Subject = "Equipamento de tecnificação não devolvido"
.HTMLBody = "Veja a planilha anexada para itens não devolvidos em sua área" & " " & .HTMLBody
.Anexos.Adicionar Wb2.FullName
'.Mandar
Terminar com
Wb2.Fechar
Matar FilePath & FileName & xFile
Definir OutlookMail = Nada
Definir OutlookApp = Nada
Application.ScreenUpdating = True
End Sub
Este comentário foi feito pelo moderador no site
Parece ser Excel 2016 e VBA 7.1
Este comentário foi feito pelo moderador no site
Oi Cristal, a minha macro perde a configuração da assinatura do e-mail, com imagens e formatação original. Como você resolve?

Sub Geraremail()

Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem

Definir OLapp = Novo Outlook.Application
Definir janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


Com janela
ActiveWorkbook.Save
.Exibição
.To = Sheets("Base").Range("A2").Value
.CC = Sheets("Base").Range("A5").Value
.Assunto = "Mapa - Acrilo " & Formato(Data, "dd.mm.aa")
assinatura = .Corpo
.Body = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando como previsão de vendas no S&OP." & Chr(10) & Chr(10) & assinatura
.Anexos.Adicionar Anexo01
Terminar com

End Sub
Este comentário foi feito pelo moderador no site
Com a mudança abaixo, consegui ajustar. Porém a letra do corpo da mensagem fica em Times New Roman. Gostaria de usar Calibri, como posso alterar o código?

Sub Geraremail()

Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem

Definir OLapp = Novo Outlook.Application
Definir janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


Com janela
ActiveWorkbook.Save
.Exibição
.To = Sheets("Base").Range("A2").Value
.CC = Sheets("Base").Range("A5").Value
.Assunto = "Mapa - Acrilo " & Formato(Data, "dd.mm.aa")
assinatura = .Corpo
.HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando como previsão de vendas no S&OP." & " " & .HTMLBody
.Anexos.Adicionar Anexo01
Terminar com

End Sub
Este comentário foi feito pelo moderador no site
Olá Milla,
O código VBA a seguir pode ajudá-lo a alterar a fonte do corpo do email para Calibri, experimente. Obrigada.
Antes de executar o código, você precisa clicar Ferramentas > Referência no Microsoft Visual Basic para Aplicações janela e, em seguida, verifique a Biblioteca de objetos do Microsoft Word caixa de seleção no Referências - Projeto VBA caixa de diálogo como a captura de tela mostrada abaixo.
[img]I:\工作\周雪明\2022年工作\6月份\文章评论截图\3.png[/img]
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
Este comentário foi feito pelo moderador no site
Olá Milla,
O código VBA a seguir pode ajudá-lo a alterar a fonte do corpo do email para Calibri, experimente. Obrigada.
Antes de executar o código, você precisa clicar Ferramentas > Referência no Microsoft Visual Basic para Aplicações janela e, em seguida, verifique a Biblioteca de objetos do Microsoft Word caixa de seleção no Referências - Projeto VBA caixa de diálogo como o arquivo anexado mostrado abaixo.
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
Não há comentários postados aqui ainda
Deixe o seu comentário
Postando como convidado
×
Avalie esta postagem:
0  Personagens
Locais sugeridos