Hallo, ik gebruik uw code om een Excel-bereik als e-mailbijlage te verzenden, maar ik krijg een runtime-fout als ik het bereik annuleer. Is er code die ik kan toevoegen of een msgbox om dit te voorkomen? Bedankt-code hieronder.
Sub-zendbereik()
Dim xFile als string
Dim xFormaat zo lang
Dim Wb als werkboek
Dim Wb2 als werkboek
Dim Ws als werkblad
Dim FilePath als string
Dim FileName As String
Dim Outlook-app als object
Dim OutlookMail als object
Dim WorkRng als bereik
xTitleId = "Voorbeeld"
Set WorkRng = Toepassing.Selectie
Set WorkRng = Application.InputBox("Bereik", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Stel Wb = Application.ActiveWorkbook in
Wb.Werkbladen.Toevoegen
Stel Ws = Application.ActiveSheet in
WorkRng.Kopieer Ws.Cells(1, 1)
Ws.Kopieer
Stel Wb2 = Application.ActiveWorkbook in
Selecteer Case Wb.Bestandsindeling
Case xlOpenXMLWerkboek:
xFile = ".xlsx"
xFormat = xlOpenXMLWerkmap
Case xlOpenXMLWorkbookMacroIngeschakeld:
Als Wb2.HasVBProject Dan
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Anders
xFile = ".xlsx"
xFormat = xlOpenXMLWerkmap
End If
Geval Excel8:
xFile = ".xls"
xFormaat = Excel8
Geval xlExcel12:
xFile = ".xlsb"
xFormaat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
Bestandsnaam = Wb.Naam & formaat (Nu, "dd-mmm-jj h-mm-ss")
Stel OutlookApp = CreateObject ("Outlook.Application") in
Stel OutlookMail = OutlookApp.CreateItem(0) in
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
Met OutlookMail
.To = "gtest@email.com"
.CC = ""
.BCC = ""
.Onderwerp = "Tests"
.Body = "Hallo."
.Bijlagen.Wb2.FullName toevoegen
.Versturen
Eindigt met
Wb2.Sluiten
Kill FilePath & FileName & xFile
Stel OutlookMail = niets in
Stel OutlookApp = Niets in
Ws.Verwijderen
Application.DisplayAlerts = Waar
Application.ScreenUpdating = True
End Sub
Sub-zendbereik()
Dim xFile als string
Dim xFormaat zo lang
Dim Wb als werkboek
Dim Wb2 als werkboek
Dim Ws als werkblad
Dim FilePath als string
Dim FileName As String
Dim Outlook-app als object
Dim OutlookMail als object
Dim WorkRng als bereik
xTitleId = "Voorbeeld"
Set WorkRng = Toepassing.Selectie
Set WorkRng = Application.InputBox("Bereik", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Stel Wb = Application.ActiveWorkbook in
Wb.Werkbladen.Toevoegen
Stel Ws = Application.ActiveSheet in
WorkRng.Kopieer Ws.Cells(1, 1)
Ws.Kopieer
Stel Wb2 = Application.ActiveWorkbook in
Selecteer Case Wb.Bestandsindeling
Case xlOpenXMLWerkboek:
xFile = ".xlsx"
xFormat = xlOpenXMLWerkmap
Case xlOpenXMLWorkbookMacroIngeschakeld:
Als Wb2.HasVBProject Dan
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Anders
xFile = ".xlsx"
xFormat = xlOpenXMLWerkmap
End If
Geval Excel8:
xFile = ".xls"
xFormaat = Excel8
Geval xlExcel12:
xFile = ".xlsb"
xFormaat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
Bestandsnaam = Wb.Naam & formaat (Nu, "dd-mmm-jj h-mm-ss")
Stel OutlookApp = CreateObject ("Outlook.Application") in
Stel OutlookMail = OutlookApp.CreateItem(0) in
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
Met OutlookMail
.To = "gtest@email.com"
.CC = ""
.BCC = ""
.Onderwerp = "Tests"
.Body = "Hallo."
.Bijlagen.Wb2.FullName toevoegen
.Versturen
Eindigt met
Wb2.Sluiten
Kill FilePath & FileName & xFile
Stel OutlookMail = niets in
Stel OutlookApp = Niets in
Ws.Verwijderen
Application.DisplayAlerts = Waar
Application.ScreenUpdating = True
End Sub