Página 1 de 1

ENVIAR E-MAIL EXCEL

Enviado: 09 Set 2020 às 16:15
por marquesdsantos
Boa tarde!

Tenho o seguinte código que envia e-mail ao fechar a planilha do Excel, mas estou querendo colocar uma opção se a pessoa quiser ou não enviar ao fechar a planilha.
No código tem o .send, tentei colocar mais não consegui.


Public Sub Enviar_Email()

total_linhas = Plan3.Range("S16")
X = Plan3.Range("S17").Text
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets(X)

For linha = 6 To total_linhas

Dim OutApp As Object
Dim OutMail As Object
Dim texto As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

If ws.Cells(linha, 35) = "SIM" Then

With OutMail
.To = Plan3.Range("S15") 'LISTA DE EMAILS
.cc = "" 'CÓPIA
.BCC = ""
.Subject = "Negociação Extraoficial de Pedidos (PCP & Comercial) - Previsão para " & X 'título
.Body = "Prezados," _
& vbNewLine & vbNewLine & _
"Ítens em atraso para atendimento:" & _
vbNewLine & vbNewLine & _
"Data de entrada: " & ws.Cells(linha, 18) & " - " & "Solicitante: " & ws.Cells(linha, 15) & _
vbNewLine & _
"Data de atendimento previsto: " & ws.Cells(linha, 21) & _
vbNewLine & _
"Resp. Autorização: " & ws.Cells(linha, 17) & _
vbNewLine & vbNewLine & _
"Produto: " & ws.Cells(linha, 6) & " Cor: " & ws.Cells(linha, 7) & " - " & ws.Cells(linha, 8) & _
vbNewLine & _
"Mês venda: " & ws.Cells(linha, 9) & " Pedido: " & ws.Cells(linha, 10) & " Ítem: " & ws.Cells(linha, 11) & _
vbNewLine & _
"Lead time de liberação: " & ws.Cells(linha, 34) & " dias" & _
vbNewLine & vbNewLine & _
"(Envio automático: FPCP 01-084 NEGOCIAÇÃO EXTRAOFICIAL DE PEDIDOS - GMM)"
'.HTMLBody = texto
'.Display 'Utilize Send para enviar o email sem abrir o Outlook
.send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Else
End If
Next linha
End Sub

Re: ENVIAR E-MAIL EXCEL

Enviado: 14 Set 2020 às 16:15
por mucascosta
Código: Selecionar todos
Sub Enviar()
Dim x As Integer
    x = MsgBox("VOCÊ QUER ENVIAR?", vbYesNo + vbQuestion, Title:="© Muca Sistemas - 2020")
If x = vbYes Then
    Enviar_Email
Exit Sub
End If
End Sub