Hey Leute,
ich habe mich nach tagelangem googeln und vielen Programmierversuchen entschlossen meine Hilfe bei euch zu suchen :). Meine VBA-Kenntnisse stammen
aus dem Studium und sind für die Aufgabe leider nicht ausreichend. Ich erwarte nicht, dass mir hier jetzt jemand einen fertigen, getesteten VBA-Code
schreibt sondern hoffe viel mehr, dass Ihr mir ein paar Gedankenanstöße oder Verweise auf ähnlich gelagerte Fälle geben könnt.
Ich möchte einen Code schreiben, der automatisch via Outlook Mails verschickt. Der Mail sollen dann bis zu zwei Anhänge beigefügt werden. Ich
kriege es zwar durchaus hin, dass Mails erzeugt werden in denen dann auch zwei Anhänge sind aber leider weiß ich nicht wie ich die Anhänge so
sortieren kann, dass sie auch zusammen passen. Es gibt bei uns zwei Arten von Rechnungen und ich möchte, wenn vorhanden jeweils diese beiden
als Anhang beifügen.
Dazu wollte ich zuerst den Ordner auswählen in dem die Rechnungen gespeichert wurden. Der Rechnungsname ist immer so aufgebaut:
Betrieb_Firmenname_1234567.pdf. Der Firmenname variiert hier in der Länge. Vielleicht habt ihr ja einen Vorschlag an mich wie ich zum Beispiel
eine Textfunktion in den Code einbauen kann.
Vielen Dank für jegliche Hilfe!!
Jetzt nochmal mein bisher erarbeiteter Code:
Option Explicit
Sub Versand_Rechnungen()
Dim Empfänger, CC, BCC, Verzeichnis, Filename, Pfad As String
Dim Mail As MailItem
Dim popup As Object
'Ordner auswählen
Set popup = CreateObject("shell.application")
Set Verzeichnis = popup.BrowseForFolder(0, "Aus welchem Verzeichnis sollen die Rechnungen kommen?", &H1, 0)
'Pfad zum gewählten Ordnder ermitteln
Pfad = Verzeichnis.Self.Path
'Bitte anpassen, sofern nötig
Empfänger = "mustermann@gmail.de"
Filename = Dir(Pfad & "\*.pdf")
Do While Filename > ""
Set Mail = Application.CreateItem(olMailItem)
With Mail
.To = Empfänger
'.CC = CC
.Subject = "Rechnungen: " & Filename
'Mailtext, der ggf. angepasst werden muss
.Body = "Sehr geehrte Damen und Herren," & vbLf _
& vbLf _
& "anbei finden Sie die Rechnung " & Filename & " zur weiteren Verarbeitung und korrigiert um die festgestellten Darstellungsfehler" & vbLf _
& vbLf _
& "Bitte beachten Sie, dass in diesem Monat erstmalig die Verrechnung mit einer neuen Version unserer genutzten Software erfolgt ist.
Trotz intensiver Tests und Prüfungen, können dennoch Fehler aufgetreten sein. Sofern Sie daher einen Fehler entdecken sollten, melden Sie
diesen gerne und wir werden eine entsprechende
Korrektur im kommenden Monat vornehmen." & vbLf _
& vbLf _
& "Viele Grüße" & vbLf _
& "Euer Uwe"
.Attachments.Add Pfad & "\" & Filename
.Attachments.Add Pfad & "\" & Filename
.ReadReceiptRequested = False
'Mail nur anzeigen
.Display
'Mail direkt versenden
'.Send
End With
Filename = Dir
Loop
Set Mail = Nothing
End Sub
|