Dateianhänge als .Attachments.Add an den SMTP übergeben

Hallo,

ich hab da mal eine frage wie man es vielleicht eleganter umsetzen kann.

Ich versende Emails über Acces und selektiere die anhänge über ein getrentes Formular

Auf diesem habe ich X Grafiken und Textfelder für die selektiere Pfadangabe

bei klick öffnet sich das Windows Selektionsfenster zur Auswahl der Datei. (10 Grafiken), welche jeder für sich angewählt werden muss.

Nun bin ich auf der Suche nach eine eleganteren Möglichkeit x Anhänge gleichzeitig auszuwählen und entsprechend zu übergeben.
Hat jemand vielleicht eine Idee der Umsetzung

1
2
3
4
5
6
7
8
9
Private Sub Anhang_1_Click()
Me.Anhang1 = DateiOeffnen("Datei öffnen", "Datenbanken" & Chr$(0) & "*.*")  
eAnhang(1) = Anhang1
End Sub
...
Private Sub Anhang_10_Click()
Me.Anhang10 = DateiOeffnen("Datei öffnen", "Datenbanken" & Chr$(0) & "*.*")  
eAnhang(10) = Anhang10
End Sub

diese Übergebe ich dann zum senden per CDO an den SMTPServer

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
.....
With objMsg
'Einfügen der anhänge  
    For w = 1 To 10
     If eAnhang(w) <> "" Then  
      .Attachments.Add eAnhang(w)  'Anhang aus formular  
     End If
    Next
'Ende Einfügen der anhänge  
....
     .To = varemail
     .SentOnBehalfOfName = "....."  
     .Subject = "Testmail: " & Betreff  
     .Importance = 0 'Wichtigkeit Hoch ( 0 = niedrig, 1 = normal, 2 = Hoch)  
     .BodyFormat = 3 '1=Plain text, 2=HTML 3=RichText  
     .Body = Mailtext 'RichText  
     .Send   'or  .display  

Grüße aus München

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 260753

Url: https://administrator.de/forum/dateianhaenge-als-attachments-add-an-den-smtp-uebergeben-260753.html

Ausgedruckt am: 14.04.2025 um 15:04 Uhr

5 Kommentare

Neuester Kommentar

Hallo Thomas,
mit einem FileDialog-Objekt bei dem die Eigenschaft MultiSelect auf True steht problemlos machbar.
Siehe dazu:

Grüße Uwe

Hallo Uwe,
danke für die Rückmeldung,

habe folgendes Probiert

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Function UseFileDialogOpen() As String

    Dim lngCount As Long
    Dim ordner As FileDialog
   
    Set ordner = Application.FileDialog(msoFileDialogFilePicker)
    With ordner
        .Title = "Auswahl"  
        .AllowMultiSelect = True
        .ButtonName = "Auswählen"  
        .Filters.Clear
        .Show
        For lngCount = 1 To .SelectedItems.Count
            UseFileDialogOpen = .SelectedItems(lngCount)
        Next lngCount
    End With
    Set ordner = Nothing
End Function

Private Sub Datei_auswählen_Click()
Dim varDateien As Variant
    varDateien = Array(UseFileDialogOpen())
   
    Set OutApp = CreateObject("Outlook.Application")  
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = "test@test.de" 'Empfaenger  
        .Subject = Betreff 'Betreff  
        .Body = Nachricht 'Nachricht  
        .Attachments.Add (varDateien) 'Anhang  
        .Display
    End With

ich sehe zwar bei UseFileDialogOpen, dass er die schleife durchläuft und die Anhänge auflistet,
nur kommt er mit den Anhängen nicht klar "ungültiger Prozeduraufruf",
kanst du hier nochmal schauen?

Das geht so leider nicht, mach es beispielsweise so:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Function UseFileDialogOpen() As String()

    Dim lngCount As Long
    Dim ordner As FileDialog
    Dim fileArray() As String
   
    Set ordner = Application.FileDialog(msoFileDialogFilePicker)
    With ordner
        .Title = "Auswahl"  
        .AllowMultiSelect = True
        .ButtonName = "Auswählen"  
        .Filters.Clear
        If .Show = -1 Then
            For lngCount = 1 To .SelectedItems.Count
                ReDim Preserve fileArray(1 To lngCount)
                fileArray(lngCount) = .SelectedItems(lngCount)
            Next        
        End If
    End With
    UseFileDialogOpen = fileArray
    Set ordner = Nothing
End Function

Private Sub Datei_auswählen_Click()
    Dim files() As String
    files = UseFileDialogOpen

    Set OutApp = CreateObject("Outlook.Application")  
    Set OutMail = OutApp.CreateItem(0)
    
    With OutMail
        .To = "test@test.de" 'Empfaenger  
        .Subject = Betreff 'Betreff  
        .Body = Nachricht 'Nachricht  
         For Each file In files
            .Attachments.Add file
         Next
        .Display
    End With
End Sub

Danke Uwe,

das wars gewesen.
eine kleine Frage habe ich da dennoch,
besteht die Möglichkeit die Werte der file in Variablen zwischen zu speichern, so das der Sendevorgang auch später noch nachgeholt werden kann ( werte dann aus den Variablen ziehend)?

Zitat von @thomas1972:
eine kleine Frage habe ich da dennoch,
besteht die Möglichkeit die Werte der file in Variablen zwischen zu speichern,

?? Ist es doch oben im Array files. Wenn du es außerhalb der Prozedur verwenden willst musst du eine öffentliche Variable außerhalb der Prozedur deklarieren und diese dann mit dem Array füllen. Dann kannst du später auch noch auf den Inhalt der Variablen zugreifen.

Also dann bspw. so:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
' Öffentliche Variable deklarieren  
Dim files() As String

Function UseFileDialogOpen() As String()
     ' ..... Code nur zur Demo weggelassen  
End Function

'Fülle Variable z.B. in einer Prozedur  
Sub FuelleVariable()
    files = UseFileDialogOpen
End Sub

'Benutze die Variable aus einer anderen Prozedur  
Sub UseVariablefromOtherSub()
    For Each file In files
        Debug.Print file
    Next
End Sub