Ich will folgendes machen:

Ich habe eine Excel-Datei. Ich habe 2 Tabellenblätter. Ein Tabellenblatt heißt "Tabelle1" und die andere heißt "Firmen“.

Ich möchte, wenn ich in Tabelle1 in Spalte u ein Datum eintrage, dass in Spalte R nachgeschaut wird, welcher Wert dort steht und anschließend dieser Wert aus Spalte R im Tabellenblatt Firmen in Spalte A gesucht wird. Wenn etwas gefunden wird, steht rechts daneben (also in Spalte B) eine E-Mailadresse.

Ich möchte jetzt eine E-Mail vorbereiten. Als Empfänger soll die gefundene E-Mailadresse übernommen werden. Als Betreff: Bestellung {wert aus spalte B}. Außerdem soll immer derselbe Text eingefügt werden (Textbaustein).

Außerdem soll ein Anhang an diese E-Mail gehängt werden: In Tabelle1 in Spalte B ist ein jeweils ein Hyperlink speziell für die Spalte hinterlegt. Der Hyperlink ist ein Dateipfad zu einem Ordner im Netzlaufwerk. Der Dateipfad ist immer ein absoluter Pfad, kein relativer. Der Hyperlink steht nicht im Klartext in dem Feld, sondern als Link des Anzeigetextes in dem Feld. Dieser Pfad soll aufgerufen werden und hier soll eine Datei als Anhang übernommen werden. Und zwar soll in diesem Ordner die Datei genommen werden, in deren Dateinamen die Zeichenfolge „BS-" vorkommt und die eine PDF ist. Anschließend soll die E-Mail verschickt werden.

Anschließend soll in dem Ordner, wo der Pfad in Spalte B hinterlegt ist, ein Unterordner mit dem Namen Bestellung erstellt werden. Als letztes soll die versendete E-Mail in diesem Ordner gespeichert werden. Als Dateiname beim Speichern der E-Mail „B {wert aus spalte r aus Tabelle1}“ verwendet werden.

Ich habe dazu den folgenden VBA-Code erstellt. Ich kriege immer bei Einfügen eines Datums in Spalte U den Laufzeitfehler aus dem angehängten Screenshot. Zum Verständnis: Wo hier im Code "TEXT" steht, steht in meinem Code mein Textbaustein, der Inhalt der zu erstellenden E-Mail. Den wollte ich hier nicht hineinkopieren.

Ich weiß nicht mehr weiter. Und ich kenne mich ehrlich gesagt auch gar nicht so wirklich mit VBA aus. Hoffentlich kann mir einer von Euch helfen?

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DateiPath As String
    Dim Dateiname As String
    Dim Datum As Date
    Dim Wert As String
    Dim Pfad As String
    Dim Empfänger As String
    Dim Betreff As String
    Dim Text As String
    Dim Auftragnehmer As String
    
    If Target.Column = 21 Then
        If IsDate(Target.Value) Then
            Datum = CDate(Target.Value)
            Wert = Worksheets("Tabelle1").Range("R" & Target.Row).Value
            
            'Suche nach dem Wert in der Spalte A in Tabelle "Firmen"
            With Worksheets("Firmen")
                Set c = .Range("A:A").Find(Wert, LookIn:=xlValues)
                If Not c Is Nothing Then
                    'Wenn Wert gefunden, nehme die E-Mail-Adresse aus der Spalte rechts neben dem Wert
                    Empfänger = c.Offset(0, 1).Value

                    'Nimm den Pfad aus dem Hyperlink in Spalte B
                    Pfad = Target.EntireRow.Hyperlinks(1).Address
                    Pfad = Left(Pfad, InStrRev(Pfad, "\"))

                    'Erstelle den Ordner, wenn er nicht vorhanden ist
                    If Dir(Pfad & "\Bestellung", vbDirectory) = "" Then
                        MkDir Pfad & "\Bestellung"
                    End If

                    'Suche nach der Datei in dem Verlinkten Ordner
                    Dateiname = Dir(Pfad & "\*BS*.pdf")

                    'Nimm den Auftragnehmer aus Spalte R
                    Auftragnehmer = Target.Offset(0, -7).Value

                    'Erstelle die Email
                    Set OutApp = CreateObject("Outlook.Application")
                    Set OutMail = OutApp.CreateItem(0)
                    With OutMail
                        .To = Empfänger
                        .BCC = ""
                        .Subject = "Bestellschein"
                        .Body = "Sehr geehrte Damen und Herren," & vbNewLine & vbNewLine & "TEXT" & vbNewLine & vbNewLine & "Mit freundlichen Grüßen,"
                        .Attachments.Add Pfad & "\" & Dateiname
                        .Send
                    End With
                    
                    'Speichere die versendete E-Mail
                    DateiPath = Pfad & "\Bestellung\Bestellung " & Wert & ".msg"
                    OutMail.SaveAs DateiPath, olMSG
                    
                    'Zeige eine MsgBox mit der Information an, welche E-Mail versendet und gespeichert wurde
                    MsgBox "E-Mail wurde an " & Empfänger & " versendet und unter " & DateiPath & " gespeichert für Vorgang " & Wert & " mit Auftragnehmer " & Auftragnehmer

                    'Lösche den Objektverweis
                    Set OutMail = Nothing
                    Set OutApp = Nothing
                Else
                    MsgBox "Keine E-Mail-Adresse gefunden für Vorgang " & Wert
                End If
            End With
        Else
            MsgBox "Ungültiges Datum in Spalte U"
        End If
    End If
End Sub