Segunda-feira, 29 2021 Março
  0 Respostas
  2.8 mil visitas
0
Votos
desfazer
Olá, estou usando seu código para enviar um intervalo do Excel como anexo de e-mail, mas recebo um erro de tempo de execução se cancelar o intervalo. Existe um código que eu possa adicionar ou uma msgbox por favor para evitar que isso aconteça? Obrigado código abaixo.

Sub SendRange()
Dim xArquivo como String
Dim xFormat por muito tempo
Dim Wb como pasta de trabalho
Dim Wb2 como pasta de trabalho
Dim Ws como planilha
Dim FilePath como String
Dim FileName como string
Dim OutlookApp como objeto
Dim OutlookMail como objeto
Dim WorkRng como intervalo
xTitleId = "Exemplo"
Se WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Definir Wb = Application.ActiveWorkbook
Wb.Planilhas.Adicionar
Definir Ws = Application.ActiveSheet
WorkRng.Copy Ws.Cells(1, 1)
Ws.Cópia
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
Com Outlook Mail
    .Para = ""
    .CC = ""
    .BCC = ""
    .Assunto = "Testes"
    .Body = "Olá."
    .Anexos.Adicionar Wb2.FullName
    .Mandar
Terminar com
Wb2.Fechar
Matar FilePath & FileName & xFile
Definir OutlookMail = Nada
Definir OutlookApp = Nada
Ws.Excluir
Application.DisplayAlerts = Verdadeiro
Application.ScreenUpdating = True
End Sub
 
Ainda não há respostas para esta postagem.