[VBS] Mail mit mehreren Anhängen (Wildcard) via Outlook senden

amn.ssy

Erfahrenes Mitglied
Hallo,

via Outlook möchte ich Mails mit mehreren Anhängen an zwei unterschiedliche Adressen senden. Das Senden mit je einer datei funktioniert auch recht gut - nur Wildcards scheinen wohl nicht zu funktionieren. Wie bekomme ich das hin?
Aus dem was ich mir bislang zusammen gegooglet habe bin ich schlau geworden und das ich nicht der Experte bin sieht man sicherlich am Code:

PHP:
Const olByValue = 1
Const olMailItem = 0

Dim oOApp 
Dim oOMail
Dim oOApp2 
Dim oOMail2

Set oFSO = CreateObject("Scripting.FileSystemObject")	

Set oOApp = CreateObject("Outlook.Application")
Set oOMail = oOApp.CreateItem(olMailItem)

Set oOApp2 = CreateObject("Outlook.Application")
Set oOMail2 = oOApp.CreateItem(olMailItem)

With oOMail
	.To = "amb@xxx.de"
	.Subject = "Abgeschlossene Aufträge mB"
	.Body = "Anbei die abgeschlossenen und unterschriebenen Aufträge (mit Beanstandungen)"
	.Attachments.Add "C:\Auftraege\X_*.pdf", olByValue, 1
	.Send
End With

with oOMail2
	.To = "aob@xxx.de"
	.Subject = "Abgeschlossene Aufträge oB"
	.Body = "Anbei die abgeschlossenen und unterschriebenen Aufträge (ohne Beanstandungen)"
	.Attachments.Add "c:\Auftraege\*.pdf", olByValue, 1
	.Send
End With

Ich vermute mal, daß ich mit dem FileSystemObject mit die Dateien aus dem Ordener holen muß. Hierzu hätte ich evtl. auch ein Beispiel - leider weiß ich aber nicht wie ich das ganze dann dem Attachments.Add übergeben soll.
Ein vielversprechendes Beispiel (VBA) sieht so aus:

PHP:
    Dim sPath As String 
    Dim sFile As String 
    Dim sAttachments As String 
    
    sPath = "Z:\Kunden\Kunde1\" 
    sFile = Dir(sPath & "1-2-3 *.pdf") 
    Do While sFile > vbNullString 
        sAttachments = "," & Chr(34) & sPath & sFile & Chr(34) 
        sFile = Dir 
    Loop 
    If Len(sAttachments) > 0 Then sAttachments = Mid$(sAttachments, 2)

Hier laufe ich jedoch ein DIR rein, was VBS wohl so nicht kennt

Im Anschluss sollen dann alle Dateien in einen Extraordner z.B. c:\gesendet verschoben werden. Aber das ist, glaub ich, ein anderes Thema :D
 
Zuletzt bearbeitet:
Bin schon im Ansatz etwas weiter gekommen und versuche es nun so:
PHP:
Const olByValue = 1
Const olMailItem = 0

Dim oOApp 
Dim oOMail
Dim oFolder
Dim oFile
Dim ixm
Dim ixo
Dim mbeanst(2)
Dim obeanst(2)

Set oFSO = CreateObject("Scripting.FileSystemObject")	
set oFolder = oFSO.GetFolder ("C:\Roiger\Auftraege\Unterschrieben")
Set oOApp = CreateObject("Outlook.Application")
Set oOMail = oOApp.CreateItem(olMailItem)

ixm = 0
ixo = 0

For Each oFile In oFolder.Files
  If Left(oFile.Name,1) = "X_" Then
    msgbox ixm & " " & oFile.Name
	mbeanst(ixm) = oFile.Name
   elseif Left(oFile.Name,1) <> "X_" Then
	msgbox ixo & " " & oFile.Name
	obeanst(ixo) = oFile.Name
  End If
  	ixm = ixm + 1
	ixo = ixo + 1	
Next

msgbox mbeanst(0)
msgbox obeanst(0)

With oOMail
	.To = "amb@xxx.de"
	.Subject = "Abgeschlossene Aufträge mB"
	.Body = "Anbei die abgeschlossenen und unterschriebenen Aufträge (mit Beanstandungen)"
	For i = 0 to ixm
	.Attachments.Add ofolder & "\" & mbeanst(i), olByValue, 1
	next
	.Send
End With
Die Idee ist das Verzeichnis zu durchlaufen, die passenden Dateien heraus zu filtern und in ein jeweiliges Array zu schreiben.
Beim Senden der Mail soll dann das Array wieder ausgelesen werden.
Die Ausgabe in die MsgBox (zur Kontrolle) läuft wie gewünscht, aber das füllen des Arrays nicht!
Nach dem ersten Durchgang für <> X_ (3 Dateien) wird ixo auf 3 gesetzt und mit X_ (ebenfalls 3 Dateien)
weitergemacht - aber nur die erste Datei.
Danach folgt ein Fehler in Zeile 27 "Index außerhalb des gültigen Bereichs".
Ich habe die beiden Arrays erstmal statisch gesetzt (zum Testen). Die sollen später dynamisch sein.
Allerdings einfach leer lassen z.B. Dim name() scheint wohl nicht zu gehen?
 
Hab mein Fehler gefunden :)
So funktioniert's jetzt ... für alle die was ähnliches haben.
Was noch fehlt ist das dynamische Array! Hat jemand einen Tipp?
Ansonsten gehts bestimmt eleganter - aber es geht
PHP:
Const olByValue = 1
Const olMailItem = 0

Dim oOApp 
Dim oOMail
Dim oOMail2
Dim oFolder
Dim oFile
Dim ixm
Dim ixo
Dim mbeanst(3)
Dim obeanst(3)

Set oFSO = CreateObject("Scripting.FileSystemObject")	
set oFolder = oFSO.GetFolder ("C:\Roiger\Auftraege\Unterschrieben")
Set oOApp = CreateObject("Outlook.Application")
Set oOMail = oOApp.CreateItem(olMailItem)
Set oOMail2 = oOApp.CreateItem(olMailItem)

ixm = 0
ixo = 0

For Each oFile In oFolder.Files
  If Left(oFile.Name,2) <> "X_" Then
	obeanst(ixo) = oFile.Name
	ixo = ixo + 1
   else
	mbeanst(ixm) = oFile.Name
	ixm = ixm + 1	
  End If	
Next

With oOMail
	.To = "xyz@abc.de"
	.Subject = "Abgeschlossene Aufträge oB"
	.Body = "Anbei die abgeschlossenen und unterschriebenen Aufträge (ohne Beanstandungen)"
	For i = 0 to 2
	.Attachments.Add ofolder & "\" & obeanst(i), olByValue, 1
	next
	.Send
End With

With oOMail2
	.To = "abc@xyz.de"
	.Subject = "Abgeschlossene Aufträge mB"
	.Body = "Anbei die abgeschlossenen und unterschriebenen Aufträge (mit Beanstandungen)"
	For j = 0 to 2
	.Attachments.Add ofolder & "\" & mbeanst(j), olByValue, 1
	next
	.Send
End With
 
Dynamische Arrays deklarierst du unter VB normalerweise so:

Visual Basic:
Dim MyArray() as String   'Oder welcher Datentyp auch immer

'Später im Code musst du dann die tatsächlichen Grenzen zuweisen
'Preserve dient dazu, in einem Array bereits enthaltene Daten zu behalten. Ohne Preserve wird das Array komplett leer gemacht.
Redim Preserve MyArray(1 to 10)

Ich weiss allerdings nicht, ob das auch mit VBS geht, dafür mache ich zuwenig VBS
 
Zurück