Mehrere Mail Empfänger in die Outlook Adresszeile

Moderator: ModerationP

Mehrere Mail Empfänger in die Outlook Adresszeile

Beitragvon Dirk2003 » 14. Sep 2021, 07:45

Hallo zusammen,

ich möchte alle Mailadressen aus einer Abfrage "quy_auswahl" über einen Button in die Adresszeile von Outlook übertragen.

Kann mir jemand einen Tipp geben?

Gruß
Dirk
Dirk2003
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 229
Registriert: 15. Sep 2008, 09:36

Re: Mehrere Mail Empfänger in die Outlook Adresszeile

Beitragvon derArb » 14. Sep 2021, 15:10

Hallo,
in Outlook wird beim Eintragen von mehreren Emailadressen als Trennzeichen der Strichpunkt verwendet (";").
Nutze das beim Zusammensetzen eines Strings in VBA durch Auslesen der Einträge Deiner Abfrage über ein Recordset
und übergib diesen String dann an OUTLOOK.

Folgendes Beispiel wird Dir helfen. Das Anpassen an Deine Problematik überlasse ich Deinem "Hirnschmalz".

ButtonCode in einem gebundenen Formular
Code: Alles auswählen
Private Sub btnSenden_Click()
Dim rs As DAO.Recordset, tmp As String
  Set rs = CurrentDb.OpenRecordset("SELECT * FROM qry_EmailSendeAuswahl WHERE EmailID_F =" & Me!emailID)
  If Not rs.EOF Then rs.MoveFirst
  While Not rs.EOF
    If Trim(Nz(rs("emailadresse"))) <> "" Then
        tmp = tmp & ";" & rs("emailadresse")
    End If
  rs.MoveNext
  Wend

  EmailVersenden Mid(tmp, 2), "", Nz(Me.Betreff, ""), Nz(Me!AnsprechText, "") & vbCrLf & vbCrLf & Nz(Me.NachrichtenText & vbCrLf & vbCrLf & _
                Nz(Me!GrussText, "") & vbCrLf & vbCrLf & Nz(Me!Sendername, "") & vbCrLf & Nz(Me!Senderstatus), ""), Me!emailID
  Me.Sendedatum = Now
  Me!gesendet = -1

End Sub


Code in einem allgemeinen Modul
Code: Alles auswählen
Option Compare Database
Option Explicit

Public Function EmailVersenden(email As String, ccEmail As String, emSubject As String, emBody As String, PK As Long)
' Bei Late Binding ==> Kein Verweis noetig!
Const olFolderInbox = 6
Const olFolderOutbox = 4
Const olMailItem = 0
Dim olApp       As Object
Dim olNamespace As Object
Dim objMailItem As Object
Dim objFolder   As Object
Dim rs As DAO.Recordset
On Error GoTo Fehler
  Set olApp = CreateObject("Outlook.Application")
  Set olNamespace = olApp.GetNamespace("MAPI")
  Set objFolder = olNamespace.GetDefaultFolder(olFolderInbox)
  Set objMailItem = objFolder.Items.Add(olMailItem)
  With objMailItem
      .To = email
      .cc = ccEmail
      .Subject = emSubject
      .Body = emBody
      Set rs = CurrentDb.OpenRecordset( _
          "SELECT doku_ID, DokuLink " & _
          "FROM tbl_Dateien " & _
          "WHERE emailID_f=" & PK)
      Do While Not rs.EOF
        If Dir(rs!DokuLink) <> "" Then
          .Attachments.Add "" & rs!DokuLink & ""
        End If
        rs.MoveNext
      Loop
      rs.Close: Set rs = Nothing
      'Application.Echo False
      .Display
  End With
  olApp.ActiveWindow
  'objMailItem.send
  'SendKeys "%s" 'für Acc2002 - 2003
  'Application.Echo True

  Set olApp = Nothing
  Set objMailItem = Nothing
  Exit Function
exit_Fehler:
Exit Function
Fehler:
MsgBox "Es ist ein Fehler aufgetreten. Schliessen Sie Outlook und versuchen Sie es bitte noch einmal."
Resume exit_Fehler

End Function
MfG
derArb

Scio me nihil scire...Εν οίδα οτι ουδέν οίδα... Ich weiss, dass ich nichts weiss (Sokrates)
Ich bevorzuge Beiträge mit korrekter deutscher Grammatik.
derArb
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 14683
Registriert: 19. Apr 2006, 18:39
Wohnort: Berlin


Zurück zu Access Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 8 Gäste