AW: Datei suchen und in Email einfügen
02.06.2022 08:51:43
MCO
Hallo Christian!
Deine Anfrage ist nicht so richtig präzise, aber ich werde mal den Code bereitstellen, in dem ich einige Annahmen treffe.
Die Daten musst du dann händisch korrigieren.
ich hab eine subroutine gebaut, die genau das macht, was du möchtest.
Die Subroutine wird via Parameter aufgerufen, die in einer Schleife die jeweils nötige Datei vorgeben. Da ich weder Pfad noch Dateinamen kenne und auch ncht weiß ob die Adressaten der Mail die gleichen sind, oder wo die herkommen, bleibt das alles nur pauschal beschrieben.
Subroutine zum Verfassen der Mail:
Sub mail(send_to As String, _
Betreff As String, _
text As String, _
sofort_senden As Boolean, _
del_gesendet As Boolean, _
Optional Kopie_an As String, _
Optional anhang As String)
'Mails versenden mit nur 1 Zeile
Dim MyMessage As Object, MyOutApp As Object, htlm_Vorgabe As String
Dim lnk_array As Variant, lnk As Long
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0)
htlm_Vorgabe = " "
text = htlm_Vorgabe & text & " "
If InStr(anhang, ";") > 0 Then
lnk_array = Split(anhang, ";")
Else
lnk_array = Array(anhang)
End If
With MyMessage
.Display
.To = send_to
.cc = Kopie_an
.Subject = Betreff
.DeleteAfterSubmit = del_gesendet
.HTMLBody = text & .HTMLBody
For lnk = 0 To UBound(lnk_array)
If lnk_array(lnk) "" Then .attachments.Add lnk_array(lnk)
Next lnk
If sofort_senden Then .Send
End With
End Sub
Aufruf der Subroutine mit Parametern
Sub zeichnungen_versenden()
Dim dat_pfad As String, mailtext As String, mailempfänger As String, in_kopie_an As String
Dim zchng As Range
'Pfad mit Anhangen
dat_pfad = "C:/Temp"
mailtext = "Hallo!
Hier wie gewünscht die aktuelle Zeichnung.
"
mailempfänger = "email.empfänger@wasweißich.de"
in_kopie_an = ""
For Each zchng In Range("A:A").SpecialCells(xlCellTypeConstants) 'hier ggf den Bereich der Zeichungsangaben anpassen
'mailempfänger = zchng.offset(0,1) 'wenn mailempfänger in der Tabelle neben den Zeichnungen steht
mail mailempfänger, "Zeichnung " & zchng.value, mailtext, 0, 0, in_kopie_an, dat_pfad & "/" & zchng
Next zchng
End Sub
Das Ganze hab ich nicht getestet, grundsätzlich hat sich die Vorgehensweise schon hundertfach bewährt.
Viel Erfolg!
Gruß, MCO