Poniedziałek, 29 marca 2021
  0 Odpowiedzi
  2.8 tys. Wizyt
0
Głosów
odpiąć
Cześć Używam twojego kodu do wysłania zakresu programu Excel jako załącznika do wiadomości e-mail, ale jeśli anuluję zakres, pojawia się błąd czasu wykonywania. Czy jest kod, który mogę dodać lub skrzynkę wiadomości, aby temu zapobiec? Dzięki kod poniżej.

Podrzędny zakres wysyłania()
Dim xFile jako ciąg
Przyciemnij xFormat tak długo
Dim Wb jako skoroszyt
Dim Wb2 jako skoroszyt
Dim Ws jako arkusz roboczy
Dim FilePath jako ciąg
Dim FileName As String
Przyciemnij OutlookApp jako obiekt
Przyciemnij OutlookMail jako obiekt
Dim WorkRng jako zakres
xTitleId = "Przykład"
Set WorkRng = Aplikacja.Wybór
Ustaw WorkRng = Application.InputBox("Zakres", xTitleId, WorkRng.Address, Type:=8)

Application.ScreenUpdating = Fałsz
Application.DisplayAlerts = False
Ustaw Wb = Application.ActiveWorkbook
Wb.Arkusze.Dodaj
Ustaw Ws = Application.ActiveSheet
WorkRng.Copy Ws.Cells(1, 1)
Ws.Kopiuj
Ustaw Wb2 = Application.ActiveWorkbook
Wybierz Case Wb.FileFormat
Sprawa xlOpenXMLKsiążka:
    xFile = ".xlsx"
    xFormat = xlOpenXMLWorkbook
Przypadek xlOpenXMLWorkbookMakroWłączone:
    Jeśli Wb2.HasVBProject to
        xFile = ".xlsm"
        xFormat = xlOpenXMLWorkbookMacroEnabled
    Więcej
        xFile = ".xlsx"
        xFormat = xlOpenXMLWorkbook
    End If
Przypadek Excel8:
    xFile = ".xls"
    xFormat = Excel8
Przypadek xlExcel12:
    xFile = ".xlsb"
    xFormat = xlExcel12
End Select
FilePath = Środowisko$("temp") & "\"
FileName = Wb.Name & Format (teraz "dd-mmm-rr h-mm-ss")
Ustaw OutlookApp = CreateObject("Outlook.Application")
Ustaw OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs Ścieżka pliku i nazwa pliku i xFile, Format pliku:=xFormat
Z OutlookMail
    .Do = ""
    .CC = „”
    .BCC = „”
    .Subject = "Testy"
    .Body = "Cześć."
    .Załączniki.Dodaj Wb2.FullName
    .Wysłać
Kończyć z
Wb2.Zamknij
Zabij ścieżkę pliku i nazwę pliku oraz xFile
Ustaw OutlookMail = Nic
Ustaw OutlookApp = Nic
Usuń
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Nie ma jeszcze odpowiedzi na ten post.