speedy1809
Goto Top

Dateianhänge an .Attachments.Add übergeben

Hallo,

ich würde gerne mal eure Hilfe in Anspruch nehmen, und zwar habe ich mir mit hilfe von google ein script zusammengewerkelt was soweit auch funktioniert.

einziges Problem, ich habe überhaubt keine Ahnung wie ich die ausgewählten Dateien an ".Attachments.Add" übergebe.

Aufgabe soll einfach sein:

Verschiedene Word-Dateien aus Ordnern und Unterordnern die ein " #" Zeichen besitzen per E-Mail zu versenden und das " #" zu löschen.

Mein Script sieht folgendermaßen aus:

On Error Resume Next
Dim strList

Set FSO = WScript.CreateObject("Scripting.FilesystemObject")  
ProcFolders FSO.GetFolder("C:\Users\frost\Desktop\Test VBS\Test\")  
 
If strList = "" Then strList = "Keine Datei" & vbCrLf  

   Set objOutlook = CreateObject("Outlook.Application")  
   Set objMail = objOutlook.CreateItem(0)

With objMail

   .To = "test@gmx.de"                            'Empfänger-Adresse.                       
   .CC = ""                                       'Sendet die Email in Kopie an die angegebene Emailadresse.  
   .BCC = ""                                      'Sendet die Email in Blind-Kopie an die angegebene Emaildadresse.  
   .Subject = "Dokumente"                         'Mail-Betreff.  
                                                  'Text                                             
   .Body = "Hallo ...," & vbCrLf & vbCrLf & _  
           "sende Dir hiermit die Dokumente im Anhang." & vbCrLf & vbCrLf & _  
           "Gruß ..." & vbCrLf & vbCrLf & vbCrLf & _  
           "Anhang:" & vbCrLf & vbCrLf & _  
           "" & strList                                    
   '.HTMLBody = ""                                'HTML-Text  

   .Attachments.Add

   .ReadReceiptRequested = False                  'Lesebestätigung anforndern. (True = wahr, False = falsch)  
   .OriginatorDeliveryReportRequested = False     'Übermittlungsbestätigung anfordern. (True = wahr / False = falsch)  
   .Sensitivity = 0                               'Vertraulichkeit. (0 = Normal, 1 = Persönlich, 2 = Privat, 3 = Vertraulich)  
   .Importance = 1                                'Wichtigkeit. (0 = Niedrig, 1 = Normal, 2 = Hoch)  
   .Display                                       'Erstellt die Email und öffnet diese. Der Versand erfolgt anschließend manuell vom User!  
   '.Send                                         'Sendet die Email automatisch.  

Set objOutlook = Nothing
Set objMail = Nothing

End With

MsgBox strList & vbCrLf & "wird gesendet:",0,""  

Sub ProcFolders(Folder)
   For Each File In Folder.Files
   If LCase(Right(File.Name,7)) = " #.docx" Then  

   'NewName = Replace(File.Name, " #", "")  
   'File.Name = NewName  

   strList = strList & File.Name & vbCrLf

   End If

Next

   For Each SubFolder In Folder.SubFolders
   On Error Resume Next
   ProcFolders(SubFolder)
   On Error Goto 0

Next

End Sub

Danke und Grüße aus Duisburg

Content-Key: 397935

Url: https://administrator.de/contentid/397935

Ausgedruckt am: 29.03.2024 um 05:03 Uhr

Mitglied: Pjordorf
Pjordorf 11.01.2019 um 15:26:07 Uhr
Goto Top
Hallo,

Zitat von @speedy1809:
einziges Problem, ich habe überhaubt keine Ahnung wie ich die ausgewählten Dateien an ".Attachments.Add" übergebe.
https://docs.microsoft.com/en-us/office/vba/api/outlook.attachments.add
https://www.experts-exchange.com/questions/20306442/How-to-add-an-attach ...
https://wellsr.com/vba/2018/excel/excel-vba-send-email-with-attachment/

Gruß,
Peter
Mitglied: speedy1809
speedy1809 11.01.2019, aktualisiert am 12.01.2019 um 14:17:46 Uhr
Goto Top
Danke für deine Antwort,

Hab mir die drei Links mal angesehen und werde da nicht so richtig schlau daraus.

Wäre vielleicht jemand mal so nett, das in meinem Script einzubauen?

Gruß Frank