Lunes, Marzo 29 2021
  0 Respuestas
  2.8K visitas
0
Votos
deshacer
Hola, estoy usando su código para enviar un rango de Excel como un archivo adjunto de correo electrónico, pero obtengo un error de tiempo de ejecución si cancelo el rango. ¿Hay código que pueda agregar o un msgbox para evitar que esto suceda? Código de gracias a continuación.

Rango de envío secundario ()
Dim xFile como cadena
Dim xFormato siempre
Dim Wb como libro de trabajo
Dim Wb2 como libro de trabajo
Dim Ws como hoja de trabajo
Dim FilePath como cadena
Dim FileName como cadena
Dim OutlookApp como objeto
Dim OutlookMail como objeto
Dim WorkRng como rango
xTitleId = "Ejemplo"
Set WorkRng = Aplicación.Selección
Establecer WorkRng = Application.InputBox("Rango", xTitleId, WorkRng.Address, Tipo:=8)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Establecer Wb = Application.ActiveWorkbook
Wb.Hojas de trabajo.Agregar
Establecer Ws = Aplicación.ActiveSheet
WorkRng.Copiar Ws.Celdas(1, 1)
Ws.Copia
Establecer Wb2 = Application.ActiveWorkbook
Seleccionar caso Wb.FileFormat
Caso xlOpenXMLLibro de trabajo:
    xArchivo = ".xlsx"
    xFormat = xlOpenXMLWorkbook
Caso xlOpenXMLWorkbookMacroEnabled:
    Si Wb2.HasVBProject Entonces
        xArchivo = ".xlsm"
        xFormat = xlOpenXMLWorkbookMacroEnabled
    otro
        xArchivo = ".xlsx"
        xFormat = xlOpenXMLWorkbook
    Si terminar
Caso Excel8:
    xArchivo = ".xls"
    formato x = Excel8
Caso xlExcel12:
    xArchivo = ".xlsb"
    formato x = xlExcel12
Fin Seleccionar
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Ahora, "dd-mmm-yy h-mm-ss")
Establezca OutlookApp = CreateObject("Outlook.Application")
Establecer OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
Con Correo de Outlook
    .Para = ""
    .CC = ""
    .BCC = ""
    .Asunto = "Pruebas"
    .Cuerpo = "Hola".
    .Archivos adjuntos.Agregar Wb2.Nombre completo
    .Enviar
End With
Wb2.Cerrar
Matar FilePath & FileName & xFile
Establecer OutlookMail = Nada
Establecer OutlookApp = Nada
Ws.Borrar
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Aún no hay respuestas para esta publicación.