Verzending van e-mail uit Access via Outlook

Status
Niet open voor verdere reacties.
G

gebo51

Gebruiker
Lid geworden
30 mei 2007
Berichten
100
VBA module aanpassen: E-mail naar BCC

Hallo,

Ik heb bijgaande module gemaakt in VBA. De module regelt de verzending van e-mail uit access via outlook aan ontvangers.
Het werkt prima, maar nu wil ik de mail niet aan ontvangers maar aan BCC sturen. Ik dacht dit te kunnen oplossen door de regel:
Code: 
  MyMail.Recipients.Add MailList("Infoadrespagina")
te vervangen door:
Code: 
MyMail.BCC.Add MailList("Infoadrespagina")

Dit geeft echter een error.

Weet iemand hier een oplossing voor?
Bedankt maar weer....:thumb:

Hieronder het VBA van de module:

Code: 
Public Function SendEMail()
On Error GoTo Err_Knop21_Click

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String

Set fso = New FileSystemObject

Subjectline$ = InputBox$("S.v.p vul in het >onderwerp< van deze mail.", _
                 "Een onderwerpregel is verplicht!")

If Subjectline$ = "" Then
    msgbox "Geen onderwerp; geen onderwerpregel; de mail wordt niet verzonden." & vbNewLine & vbNewLine & _
        "Alsluiting...", vbCritical, "bedrijf"
    Exit Function
End If

BodyFile$ = InputBox$("S.v.p. vul in het pad en de bestandsnaam voor de omschrijvingtekst in de mail.", _
             "c:\test\test.txt")

If BodyFile$ = "" Then
    msgbox "Geen omschrijvingstekst; de mail wordt niet verzonden." & vbNewLine & vbNewLine & _
         "afsluiting...", vbCritical, "bedrijf"
    Exit Function
End If

If fso.FileExists(BodyFile$) = False Then
    msgbox "TDe bestandsnaam voor de omschrijvingstekst is niet gevonden. " & vbNewLine & vbNewLine & _
           "Afsluiting...", vbCritical, "Bedrijf"
    Exit Function
End If

    Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)
    MyBodyText = MyBody.ReadAll
    MyBody.Close
    Set MyOutlook = New Outlook.Application
    Set db = CurrentDb()
    Set MailList = db.OpenRecordset("qryZendmail")

        Set MyMail = MyOutlook.CreateItem(olMailItem)
        Do Until MailList.EOF
        MyMail.Recipients.Add MailList("Infoadrespagina")

	MailList.MoveNext
	Loop
           MyMail.Subject = Subjectline$
            MyMail.Body = MyBodyText

            'MyMail.Attachments.Add "c:\test\sinn.doc", olByValue, 1, "My Displayname"
	mymail.display boven mymail.send.
            MyMail.Display
            MyMail.Send
	Set MyMail = Nothing
	Set MyOutlook = Nothing
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing

Exit_Knop21_Click:
Exit Function

Err_Knop21_Click:
   msgbox "U heeft de mailbewerking afgebroken", vbExclamation, "Bedrijf"
    Resume Exit_Knop21_Click
End Function
 
Laatst bewerkt:
Beste Huijb,

Dank voor de aanpassingen.
Wellicht is de 'onderwerp' tekst ook voor verbetering vatbaar, deze is echter (m.i.) niet meer aan te passen.

Mvg
 
Als ik jou was zou ik niet via Outlook gaan mailen, maar even googlen op CDOSYS
 
Beste Rene

Dank voor je reactie.

Het was voor mij een hele klus om via het vermelde vba de emailverzending voorelkaar te krijgen en zoals het nu werkt ben ik eigenlijk wel tevreden.
Alleen dus het kunnen mailen via BCC zoul ik nog graag willen.

Is er een mogelijkheid via de door mij gekozen vba oplossing??

Dank :thumb:
 
Ik laat je toch even de cdo oplossing zien, je moet dan even in extra/verwijzingen naast de Microsoft scripting runtime ook de cdo library installeren (c:\windows\system32\cdosys.dll)

Code: 
Public Function SendEMail()
On Error GoTo SendEMail_Err

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim Subjectline As String
Dim BodyFile As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim MyBodyText As String
[B]Dim objMail As New CDO.Message
Dim strRecps As String[/B]

[B]'Dit stukje is alleen om ervoor te zorgen dat je een eigen smtp server kan kiezen
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2   'use smtp
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.server.nl"
objMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMail.Configuration.Fields.Update[/B]

Set fso = New FileSystemObject

Subjectline$ = InputBox$("S.v.p vul in het >onderwerp< van deze mail.", _
                 "Een onderwerpregel is verplicht!")

If Subjectline$ = "" Then
    MsgBox "Geen onderwerp; geen onderwerpregel; de mail wordt niet verzonden." & vbNewLine & vbNewLine & _
        "Alsluiting...", vbCritical, "GO! Evenementen & Communicatie"
    Exit Function
End If

BodyFile$ = InputBox$("S.v.p. vul in het pad en de bestandsnaam voor de omschrijvingtekst in de mail.", _
             "c:\test\test.txt")

If BodyFile$ = "" Then
    MsgBox "Geen omschrijvingstekst; de mail wordt niet verzonden." & vbNewLine & vbNewLine & _
         "afsluiting...", vbCritical, "bedrijf"
    Exit Function
End If

If fso.FileExists(BodyFile$) = False Then
    MsgBox "TDe bestandsnaam voor de omschrijvingstekst is niet gevonden. " & vbNewLine & vbNewLine & _
           "Afsluiting...", vbCritical, "Bedrijf"
    Exit Function
End If

    Set MyBody = fso.OpenTextFile(BodyFile, ForReading, False, TristateUseDefault)
    MyBodyText = MyBody.ReadAll
    MyBody.Close
    Set db = CurrentDb()
    Set MailList = db.OpenRecordset("qryZendmail")

[B]    'even toegevoegd: het is nl nooit zeker of een recordset bij de 1e record begint
        'in access wel, maar mocht je odbc gebruiken dan niet
[B]    If MailList.RecordCount <> 0 Then
        MailList.MoveFirst
        Do Until MailList.EOF
            'we stoppen even alle adressen in een string
            'je zou dit mooier kunnen oplossen door voor iedere
            'entry in de recordset een mail te maken. Je kunt dan bv ook
            'persoonlijke emails maken, of de mails naar de gebruikers zelf sturen
            strRecps = strRecps & ";" & MailList("Infoadrespagina")[/B]
            MailList.MoveNext
        Loop
        [B]strRecps = Mid(strRecps, 2)  'remove leading ;[/B]
        objMail.BCC = strRecps
        objMail.TextBody = MyBodyText
        objMail.Subject = Subjectline$
        'objMail.AddAttachment "c:\test\sinn.doc"
        objMail.Send
        
        Set objMail = Nothing
    End If
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing

Exit_SendEMail_Err:
Exit Function

SendEMail_Err:
   MsgBox "U heeft de mailbewerking afgebroken", vbExclamation, "Bedrijf"
    Resume Exit_SendEMail_Err
End Function

Je ziet, niet zo heel veel anders. Nu kun je ook gebruik maken van
objMail.Sender
objMail.CC
objMail.To
objMail.From
objMail.HTMLBody


En het allermooiste: het werk ook zonder Outlook. Mocht je nog vragen hebben dan hoor ik het wel...
 
Beste Rene

Hartelijk dank voor je duidelijke uitleg en voorbeeld:thumb:
Ik ga het installeren en laat je nog even weten of het is gelukt.

Mvg (en fijne jaarwisseling:)
 
Beste Rene,

Ik heb je code toegepast, maar loop tegen het volgende probleem(pje) op.
Voordat ik de mail verzend wil ik deze graag van te voren zien.
In mijn eigen code gebruikte ik daarvoor:
mymail.display

Dit werkt niet met:
objMail.Display

Heb je hier een oplossing voor?

Dank:thumb:
 
gebo51 zei:
objMail.Display
Klik om te vergroten...
Da's helaas niet mogelijk. Het mailobject heeft geen grafische interface, daarom kun je 'm ook op webpagina's, in controls, etc gebruiken. Ik maak meestal een checkbox met 'testversie' en codeer dan iets als volgt:

Code: 
if bTestmode then
   objMail.To="mijnemailadres@helpmij.nl"
else
   objMail.To="echte_ontvanger@helpmij.nl"
end if

Op deze manier kan ik even zien of de mail er echt zo uit ziet als ik 'm wil hebben.
Over wat ik je eerder had vermeld - wat bertreft persoonlijke mails - stel je hebt een tabel TBL_users met naam, email, aanhef en een tekstbestand mail.txt met daarin Beste @naam@, etc, dan zou je dus zo iets kunnen maken:

Code: 
strText = fso.readall(filename)
'in de loop
strText = replace(strText,"@naam@", rst("Naam"))
strSubject = "mail voor " & rst("Naam")
etc
 
Beste Rene

Dank voor je verhelderende en uitgebreide reactie:)
Dikke prima:thumb:

Ik ga er mee aan de slag en meldt mij weer als het geheel functioneert, of ik weer wat te zeuren heb:confused:.
Mvg
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan