VBA: Abfrage ActiveSheet in Blatt 1 bis 12
04.11.2019 21:32:41
Peer
Ich habe mir gerade aus einigen Internetschnipseln einen Code zum Versenden von Sheets gebastelt und er funktioniert auch schon ganz gut.
Nun möchte ich prüfen lassen, ob das aktive Sheet im dem Workbook eines der ersten 3 Blätter ist. Sie heißen "Januar" bis "März". Wenn nicht, soll es eine MsgBox anzeigen, ansonsten die Email-Routine ausführen.
Irgendwie stehe ich auf den Schlauch.
"If then else" funktioniert nur für ein Blatt (denke ich) und mit Arrays will es auch nicht klappen.
Hier mein bisheriger Versuch:
Dim mePDFD As String 'Anhang-Name
Dim MyOutApp As Object 'Email Client
Dim MyMessage As Object 'Email-Kopf
Dim Adressat As Object 'Empfänger
Dim arrMonat()
'Anhang-Name definieren
mePDFD = ThisWorkbook.Path & "\" & "Erfassungsbeleg für den Monat " & Format(ActiveSheet. _
Range("E4"), "MMMM"" ""YYYY") & ".pdf"
'aktuelle Tabelle in die Zwischenanlage kopieren
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mePDFD, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Close False
Set MyOutApp = CreateObject("Outlook.Application") 'Email-Client festlegen
Set MyMessage = MyOutApp.CreateItem(0) 'neue Email erstellen
Set Adressat = Sheets("Parameter").Cells(30, 1) 'Empfänger aus Tabelle "Parameter"
arrMonat = Array("Januar", "Februar")
If ThisWorkbook.ActiveSheet = arrMonat Then
With MyMessage
.To = Adressat 'oder "peer.roedel@gmx.de"
.Subject = "Erfassungsbeleg" 'Betreffzeile
.body = "Lieber Kollege" & vbCrLf & vbCrLf _
& "Im Anhang der Erfassungsbeleg" & vbCrLf & vbCrLf & _
"Mit freundlichen Grüßen" & vbCrLf & ActiveSheet.Cells(5, 5)
.Attachments.Add mePDFD 'Anhang aus Zwischenanlage einfügen
.Display 'alles anzeigen
End With
Else: MsgBox "kein Monat ausgewählt"
End If
Kill mePDFD
Set MyMessage = Nothing
Set MyOutApp = Nothing
Vielen Dank
Peer