By Гвентейлор в понедельник 29 март 2021
Опубликовано в Excel
Ответы 0
Лайк 0
Просмотры 2.8K
Голосов 0
Привет, я использую ваш код для отправки диапазона Excel в виде вложения электронной почты, но получаю ошибку времени выполнения, если я отменяю диапазон. Есть ли код, который я могу добавить, или msgbox, чтобы этого не произошло? Код благодарности ниже.

Sub SendRange ()
Развернуть xFile как строку
Dim xFormat как длинный
Dim Wb как рабочая книга
Dim Wb2 как рабочая тетрадь
Dim Ws как рабочий лист
Dim FilePath как строка
Dim FileName As String
Dim OutlookApp как объект
Dim OutlookMail как объект
Тусклый рабочий диапазон как диапазон
xTitleId = "Пример"
Set WorkRng = Приложение.Выбор
Установите WorkRng = Application.InputBox ("Диапазон", xTitleId, WorkRng.Address, Type: = 8)

Приложение.ScreenUpdating = False
Приложение.DisplayAlerts = False
Установите Wb = Application.ActiveWorkbook
Wb.Worksheets.Добавить
Установите Ws = Application.ActiveSheet.
WorkRng.Copy Ws.Cells (1, 1)
Ws.Копировать
Установите Wb2 = Application.ActiveWorkbook
Выберите регистр Wb.FileFormat.
Случай xlOpenXMLWorkbook:
    xFile = ".xlsx"
    xFormat = xlOpenXMLWorkbook
Случай xlOpenXMLWorkbookMacroEnabled:
    Если Wb2.HasVBProject, то
        xFile = ".xlsm"
        xFormat = xlOpenXMLWorkbookMacroEnabled
    Еще
        xFile = ".xlsx"
        xFormat = xlOpenXMLWorkbook
    End If
Случай Excel8:
    xFile = ".xls"
    хФормат = Excel8
Случай xlExcel12:
    xFile = ".xlsb"
    хФормат = кслExcel12
End Select
FilePath = Environ $ ("temp") & "\"
FileName = Wb.Name & Format (теперь "дд-ммм-гг ч-мм-сс")
Установите OutlookApp = CreateObject ("Outlook.Application")
Установите OutlookMail = OutlookApp.CreateItem (0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat: = xFormat
С OutlookMail
    .To = "gtest@email.com"
    .CC = ""
    .BCC = ""
    .Subject = "Тесты"
    .Body = "Привет."
    .Attachments.Добавить Wb2.FullName
    .Послать
Конец с
Wb2.Закрыть
Убить FilePath & FileName & xFile
Установите OutlookMail = Nothing
Установите OutlookApp = Nothing
Ws.Удалить
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Посмотреть сообщение полностью