Mein Anliegen ist ähnlich wie das von Katharina, vom 02.10.2012.
https://www.herber.de/forum/archiv/1280to1284/1280211_VBA_Datei_suchen_inkl_Unterordner.html
Und zwar:
In unseren Lieferantenlisten führen wir datenbankmässig pro Lieferant die LiefNr, LiefNamen, LiefEmail, Anrede, Textblöcke, etc. Sie beinhalten so ca. 50 bis 100 Lieferanten. Etwa ein Dutzend solcher Listen wird von einem Team betreut.
Im Netzwerkverzeichnis (G:\projekte\Q_E\Logistik\) besitzt jeder Lieferant sein eigenes Verzeichnis (Zihlmann_Profiltechnick_AG-094732) mit seiner typischen LiefNr am Ende des Verzeichnisnamens. Darin befinden sich die Terminlisten (07.03.2016-Termine-Zihlmann_Profiltechnick_AG-094732.xls) auch mit ihren typischen LiefNr im Dateinamen. Diese werden jeweils montags automatisch generiert und müssen dann manuell via Email an den Lieferanten versendet werden.
Gerne würde ich nun diese wöchentliche Routinearbeit per Makro automatisieren. Der Teil des Makros, welcher das Outlook initialisiert, eine neue Email öffnet, den AN:-Empfänger, den CC:-Empfänger, den Betreff und den Email-Body aus der Lieferantenliste pickt, steht bereit und funzt. Aber: In meiner Testversion wird der Anhang für das Email, d.h. die entsprechende Terminliste, noch aus einem festcodierten Pfad entnommen. Das Modul mit der Serien-Mail-Prozedur habe ich weiter unten aufgeführt.
An dieser Stelle benötigt ein VBA-Frischling wie ich, eure Erfahrung und Hilfe. Für mein Verständnis müsste man an der Stelle der IF-Schleife, wo die entsprechende Terminliste übernommen wird:
mit der LiefNr im Verzeichnis den entsprechenden Lieferantenordner auswählen
Diesen Ordner öffnen und darin die letzte (gemäss Datum) Terminliste auswählen
Diese Terminliste dann als String (strTerminFollowUp) in meine bestehende Prozedur übergeben
Die so ermittelte Terminliste kann dann im gerade aufbereiteten Email als Attachement angehängt werden.
Ich habe hier einiges versucht. Aber meine heutigen VBA-Kenntnisse reichen dafür leider nicht aus. Kann mir evtl. jemand von euch auf die Sprünge helfen?
Besten Dank.
Sub TerminFollowUpSerial()
'Andreas Thehos, http://thehosblog.com
Dim objOLOutlook As Object 'Variable für die Applikation Outlook
Dim objOLMail As Object 'Variable für die einzelnen E-Mails
Dim intMailNr As Integer 'Variable für die Anzahl Emails
Dim intZaehler As Integer 'Variable für den Zähler (welche Email-
Zeile wird gerade angesprochen)
Dim strTermineFollowUp As String 'Variable für die Terminliste
Dim strSignatur As String 'Variable für die Signatur
On Error GoTo ErrorHandler
Set objOLOutlook = CreateObject("Outlook.Application")
intMailNr = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
For intZaehler = 7 To intMailNr
If Cells(intZaehler, 1) "" Then
Set objOLMail = objOLOutlook.CreateItem(olMailItem)
With objOLMail
.To = Cells(intZaehler, 10)
.CC = ""
.BCC = ""
.Sensitivity = 0
.Importance = 0
.Subject = "Termine Follow Up Alstom Grid Switzerland"
'.Attachments.Add strTermineFollowUp
'Hier sollte die Anlage (Terminliste) für den passenden
'Lieferanten aufgerufen werden!
.BodyFormat = olFormatHTML
.Body = Cells(intZaehler, 14) & vbCrLf & vbCrLf & _
Cells(intZaehler, 15) & vbCrLf & _
"Hier kommt die Signatur hin..."
.DeleteAfterSubmit = False
.Send
'.Display
End With
Set objOLMail = Nothing
End If
Next intZaehler
Set objOLOutlook = Nothing
Exit Sub