Hallo zusammen,

leider finde ich zu meinem Anliegen nirgend einen Ansatz.

Ich frage mehrmals am Tag in Outlook via Excel in die Anzahl der enthaltenen Mails verschiedener Postfächer ab. Anschließend wird mit dem folgenden Code eine der 50 Mails gesendet.

Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
Set SendUsingAccount = Session.Accounts.Item("test@test.de")
Set SendUsingAccount = Session.Accounts.Item("test2@test2.de")

abc = Range("J2")
abcd = Range("M8")
Zeitpunkt = Date
Zeitpunkt2 = Now

If Range("K5") > 0 Then
Anzahl1 = Range("K5").Value
Addi1 = Range("L5").Value
Nam1 = Range("I5").Value
With objMail
'.SentOnBehalfOfName = abc
.To = Addi1
'.BCC = "test3@test3.de"
.Subject = "test4 " & Zeitpunkt
.body = "Hallo " & Nam1 & "," _
& Chr(10) & Chr(10) & "in Deinem Ordner im Postfach test@test.de befinden sich Mails bzw. MVPs." _
& Chr(10) & Chr(10) & "Anzahl: " & Anzahl1 & " Stück" _
& Chr(10) & Chr(10) & "Zeitpunkt der Auslesung: " & Zeitpunkt2 _
& Chr(10) & Chr(10) & "Bitte diese in Dein Postfach holen und bearbeiten." _
& Chr(10) & Chr(10) & "Vielen Dank und Dir einen schönen Tag." _
& Chr(10) & Chr(10) & "Diese Mail wurde elektronisch erstellt und ist ohne Name / Grußformel / Unterschrift gültig :)"
.Display
'.Send
End With
End If


Dies funktioniert auch sehr gut.

Allerdings hat mein Arbeitgeber nun die Pflicht zur Klassifizierung der Vertraulichkeit in Outlook eingeführt. Ich kann die Mails seit heute nicht mehr automatisiert senden lassen. Stattdessen muss ich sie mir mit .display anzeigen lassen und manuell die Klassifizierung auswählen. Dies verlangsamt das ganze schon sehr.

In Excel müssen wir schon länger klassifizieren. Dies funktioniert auch sehr gut mit folgendem Code:

Dim docSenseLabel As SensitivityLabel
Dim labelInfo As Office.labelInfo
Set docSenseLabel = ActiveWorkbook.SensitivityLabel 'WB evtl. anpassen
Set labelInfo = docSenseLabel.CreateLabelInfo()
With labelInfo
.AssignmentMethod = 1
.IsEnabled = True
.LabelId = "f0f5f9da-bb59-43e3-a7aa-358435e03557" 'Intern, ID aus Prod
.LabelName = "(C2) Intern" 'optional, zum Verstehen der LabelID
.SetDate = Now()
End With
docSenseLabel.SetLabel labelInfo, labelInfo

Hat jemand eine Idee, wie ich diese beiden Codes zusammenbringen kann, so dass Excel direkt die Klassifizierung in Outlook übernimmt und wieder ein automatisches versenden möglich ist??

Für Eure Hilfe und Mühe bedanke ich mich bereits jetzt schon.

Viele Grüße
Marc