Thema: Blatt als Mail per Dropdown an bestimmten Empfängerkreis

Einen schönen guten Tag,

ich habe folgendes Problem:

Ich habe ein Tabellenblatt (ich nenne dieses "Aussonderung") , in dem ich aus einem Dropdown diverse "Orte" auswählen kann.
Diese Orte sind in einem separaten Tabellenblatt (dieses nenne ich "Standorte") aufgelistet.
Die "Orte" stehen in Spalte A.
In Spalte B sind den "Orten" zugeordnete E-Mail-Empfänger aufgelistet.
Nun möchte ich, dass wenn ich im Tabellenblatt "Aussonderung" in meinem Dropdown einen Ort auswähle, automatisch der richtige E-Mail-Empfängerkreis das Blatt "Aussonderung" als PDF per Mail gesendet bekommt.

Kann mir da jemand weiterhelfen? Ich habe in der ganzen Arbeitsmappe die diversesten Makros, mit denen automatisch die aktiven Blätter per Mail versendet werden - eben aber nur an einen vorher definierten Empfänger / Empfängerkreis. Ich blicke nicht ganz durch, wie ich das ganze "dynamisch" gestalten kann.

Ich kann leider keine Beispieldatei hochladen, da diese Datei zu viele sensible Inhalte enthält.

Vielen Dank für eure Hilfe und schöne Grüße

Machotill

Hallöchen,

1)
man kann die Daten durch Pseudodaten ersetzen
2)
eben aber nur an einen vorher definierten Empfänger / Empfängerkreis.
nimm statt den "festen" Adressen den Inhalt einer Zelle. Du kannst anhand der Auswahl des Ortes den Empfängerkreis per SVERWEIS in eine Zelle holen, auf die Du Dich beziehst.

Vielen Dank!
Manchmal sieht man den Wald vor lauter Bäumen nicht...hat funktioniert.

Schöne Grüße

P.S. : Die Daten zu ersetzen wäre bei der Menge zu aufwändig gewesen.

Hallo,

hier eine Idee, wie Du das machen könntest.....

In Ermangelung einer Vorlage von Dir eine ungetestete Version.

Code:


Sub Test()
  MailMitPDFundSignatur "Freigericht"       ' Hier Ort aus DropDown übergeben
End Sub

Sub MailMitPDFundSignatur(sOrt As String)
  Dim sDateiname As String, WSh As Worksheet, vGefunden As Variant, sTo As String
 
  Set WSh = ThisWorkbook.Sheets("Aussonderung")
  With ThisWorkbook.Sheets("Standorte")
      vGefunden = Application.Match(sOrt, .Columns(1), 0)
      If Not IsNumeric(vGefunden) Then Exit Sub
      sTo = .Cells(vGefunden, "B").Value
  End With

' PDF erzeugen
  sDateiname = WSh.Parent.Path & "\" & "Aussonderung.pdf"
  WSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDateiname, _
      Quality:=xlQualityStandard, OpenAfterPublish:=False
  
' Mail kreieren
  With CreateObject("Outlook.Application").CreateItem(0)
      .Getinspector.Display                 ' sorgt für die Signatur
      .To = sTo                             ' Empfänger
      .Subject = "Ich bin ein Betreff"      ' Betreff
      .Body = "Hallo," & vbCr & vbCr _
            & "anbei die PDF Datei:" & vbCr _
            & "Bitte Antwort an unseren Verteiler" _
            & vbCr & .Body                  ' Mailtext mit Signatur
       If Dir$(sDateiname) <> "" Then .Attachments.Add sDateiname
  End With
End Sub

Danke für deine Hilfe!

Hab es mit der o.g. Methode hinbekommen, danke dir trotzdem!