thomas1972
Goto Top

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

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


.....
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

Content-Key: 260753

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

Printed on: April 24, 2024 at 14:04 o'clock

Member: colinardo
colinardo Jan 22, 2015 updated at 08:41:19 (UTC)
Goto Top
Member: thomas1972
thomas1972 Jan 22, 2015 updated at 13:13:16 (UTC)
Goto Top
Hallo Uwe,
danke für die Rückmeldung,

habe folgendes Probiert

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?
Member: colinardo
colinardo Jan 22, 2015 updated at 13:23:47 (UTC)
Goto Top
Das geht so leider nicht, mach es beispielsweise so:
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
Member: thomas1972
thomas1972 Jan 22, 2015 at 13:36:46 (UTC)
Goto Top
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)?
Member: colinardo
colinardo Jan 22, 2015 updated at 17:57:14 (UTC)
Goto Top
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:
' Ö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