As treasurer I am required to sent out invoices to each member. I have a tblMembers (Autonumber = JPID) file and a tblSubs (Number =JPSUBID). I have complied the report (invoice) and would like to be able to email as opposed to post. The invoice, of course is personally addressed to each member.

I am familiar with sending out just a single email for a member but not sure on doing it en masse. Can anyone help me please with the appropriate code so each member recives their own invoice?

Any help greatly appreciated. Thanks.

Le 28/10/2012 18:48, rwpear...@clear.net.nz a écrit :

I use Blat :

<http://oldsite.blat.net/>

--
kd

You can control Outlook by automation and loop through all the records in a
dataset sending an email through Outlook for each one.  This has the
advantage over some processes where multiple email addresses are put in the
"To:" line, in this case each addressee sees only their own address.  There
must be example code around somewhere.

David

That looks interesting.  If run from Access how do you handle run time
errors?  Say if the email address is invalid or the server is down.  I don't
much like the idea of the user having to inspect a log file to find out what
went wrong.

As I understand it by using Shell() to execute blat.exe you cannot get the
code returned by blat.  Is that right?

Apparently there is a dll version of blat.  I suppose if you call that from
Access you would be able to retrieve the blat return.  Is that right and
have you tried it?

David

Le 29/10/2012 04:45, David Hare-Scott a crit :

Hi David,

I give you an exemple of code (you can find it on the web), my English
is too bad to explain.
I hope you can understand it.
'Blat.dll' is not so easy to find, if you dont I will send you both 32
and 64 bits libraries.

************************************************
MODULE
************************************************
Option Compare Database
Option Explicit

Enum MailPriority
LOW_PRIORITY = &H0
HIGH_PRIORITY = &H1
End Enum

Public Declare Function SendBlat Lib "blat.dll" Alias "Send" (ByVal
sCmd As String) As Integer
Public Declare Function LoadLibrary Lib "kernel32" Alias
"LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub SendMail(MailTo As String, _
Sujet As String, _
Detail As String, _
Optional AttachFiles As String, _
Optional Mailcc As String, _
Optional Mailbcc As String, _
Optional Priority As MailPriority = &H2, _
Optional Confirmation As Boolean)

Dim Signature As String
Dim ifScinder As String
Dim ifLog As String
Dim StringValue As String
Dim result As Integer
Dim hLib As Long

'// Charge la DLL
hLib = LoadLibrary("Blat.dll")
If hLib = 0 Then
hLib = LoadLibrary(CurrentProject.Path & "\Blat.dll")
If hLib = 0 Then
MsgBox "Impossible de trouver le fichier Blat.dll " & vbCrLf & vbCrLf
& "S.V.P. copier le fichier dans le dossier syst me" & vbCrLf & "ou
dans le dossier " & CurrentProject.Path, vbOKOnly, "Envois de l'email"
Exit Sub
End If
End If

'// Destinataire
StringValue = "Mail -to " & MailTo

'// Copie conforme
If Len(Mailcc) > 0 Then
StringValue = StringValue & " -cc " & Mailcc
End If

'// Copie conforme invisible
If Len(Mailbcc) > 0 Then
StringValue = StringValue & " -bcc " & Mailbcc
End If

'// Prorit d'envois
If Priority <> &H2 Then
StringValue = StringValue & " -Priority " & Priority
End If

'// Fichier attach s
If Len(AttachFiles) > 2 Then
StringValue = StringValue & " -Attach " & AttachFiles
End If

'// Confirmation de lecture
If Confirmation = True Then
StringValue = StringValue & " -d"
End If

'// Signature
Signature = ReadRegistry("HKLM", "SoftWare\Public Domain\Blat",
"Signature", "S", "")
If Len(Signature) > 0 Then
StringValue = StringValue & " -sig " & Chr(34) & Signature & Chr(34)
End If

'// Fichier Log
ifLog = ReadRegistry("HKLM", "SoftWare\Public Domain\Blat", "Log",
"S", "")
If Nz(ifLog) = -1 Then
StringValue = StringValue & " -log " & Chr(34) & CurrentProject.Path &
"\Blat.log" & Chr(34)
End If

'// Scinder le message
ifScinder = ReadRegistry("HKLM", "SoftWare\Public Domain\Blat",
"Scinder", "S", "")
If Nz(ifScinder) = -1 Then
StringValue = StringValue & " -multipart " & Nz(ReadRegistry("HKLM",
"SoftWare\Public Domain\Blat", "NbrKo", "S", ""))
End If

StringValue = StringValue & _
" -subject " & Chr(34) & IIf(Estvide(Sujet), " ", Sujet) & Chr(34) & _
" -body " & Chr(34) & IIf(Estvide(Detail), " ", Detail) & Chr(34) & _
" -noh"

'// Envois du courriel
'Probl me pour la progress bar cause du mail Synchrone
DoCmd.OpenForm "frmWait": Sleep 1000: DoEvents
result = SendBlat(StringValue)
'DoCmd.Close acForm, "frmWait"

If result = 0 Then
MsgBox "Mail envoy avec succ s !", vbInformation, "Envois de l'email"
Exit Sub
Else
Select Case result
Case 1
MsgBox "Bad argument given", vbExclamation, "Erreur"
Case 2
MsgBox "File (message text) does not exist", vbExclamation, "Erreur"
Case 3
MsgBox "Error reading the file (message text) or attached file",
vbExclamation, "Erreur"
Case 4
MsgBox "File (message text) not of type", vbExclamation, "Erreur"
Case 5
MsgBox "Error Reading File (message text)", vbExclamation, "Erreur"
Case 12
MsgBox "-server or -f options not specified and not found in
registry", vbExclamation, "Erreur"
Case 13
MsgBox "Error opening temporary file in temp directory",
vbExclamation, "Erreur"
Case Else
MsgBox "Bad argument given", vbExclamation, "Erreur"
End Select
End If
End Sub

*******************************************************
FORMULAIRE
*******************************************************
Option Compare Database
Option Explicit

Dim PDFPath As String
Dim ModeSelected As String
Dim FlipAttache As Boolean
Dim NumPos As Long '1-Normal 2-Bas
Dim BackPos As Long
Dim FirstOpen As Boolean

Private Sub cmdBrowse_Click()
On Error Resume Next
Dim strFilter As String
Dim lngFlags As Long
Dim strReponse As String
Dim strPath As String

strFilter = ahtAddFilterItem(strFilter, "Tous les fichiers (*.*)", "*.*")
strReponse = ahtCommonFileOpenSave(InitialDir:=CurDir,
Filter:=strFilter, FilterIndex:=2, Flags:=lngFlags,
DialogTitle:="Choisir un fichier")

If strReponse <> "" Then
Me!lstFiles.AddItem strReponse & ";" & Dir(strReponse)
End If

End Sub

Private Sub cmdDelete_Click()
If Me!lstFiles.ListIndex = -1 Then Exit Sub

If MsgBox("Voulez-vous vraiment supprimer '" & Me!lstFiles & "' de la
liste ?", 4 + 32 + 256, "Confirmation") = 6 Then
Me!lstFiles.RemoveItem Me!lstFiles.ListIndex
End If
End Sub

Private Sub cmdOpen_Click()
If Me!lstFiles.ListIndex = -1 Then Exit Sub
Call RunShellExecute("Open", PDFPath & Me!lstFiles, 0&, 0&, SW_SHOWNORMAL)
End Sub

Private Sub cmdRenomer_Click()
Dim NewFiles As String
Dim NewFullPath As String

On Error GoTo RenErr

If Me!lstFiles.ListIndex = -1 Then Exit Sub

NewFiles = InputBox("Entrez le nom du nouveau fichier :", "Renommer",
Me!lstFiles.Column(1))

If NewFiles <> "" Then
NewFullPath = Left(Me!lstFiles, Len(Me!lstFiles) -
Len(Dir(Me!lstFiles))) & NewFiles
Name Me!lstFiles As NewFullPath
Me!lstFiles.RemoveItem Me!lstFiles.ListIndex
Me!lstFiles.AddItem NewFullPath & "," & Dir(NewFullPath)
End If
Exit Sub

RenErr:
MsgBox Err.Description, vbExclamation, "Erreur"
End Sub

Private Sub D tail_MouseDown(Button As Integer, Shift As Integer, X As
Single, Y As Single)
' Call lstPriority_AfterUpdate
End Sub

Private Sub D tail_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
If Me!cdrAttache.Visible = True Then Me!cdrAttache.Visible = False
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 27 Then DoCmd.Close
End Sub

Private Sub Form_Open(Cancel As Integer)
'Call SetFormIcon("Mail.ico", Me.Name, Me.hwnd)
ModeSelected = "cdrC"
FirstOpen = True
End Sub

Private Sub lblA_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
Me.FlagFocus.SetFocus
End Sub

Private Sub lblAnnuler_Click()
DoCmd.Close
End Sub

Private Sub lblConfig_Click()
DoCmd.OpenForm "frmSMTP_Config"
End Sub

Private Sub lblJoindre_Click()
Call FlipJoindre(True)
End Sub

Private Sub lblPrority_Click()
Me!FlagFocus.SetFocus
Me!BoxPriority.Visible = True
Me!lstPriority.Visible = True
End Sub

Private Sub lblSend_Click()

If IsNull(ReadRegistry("HKLM", "SoftWare\Public Domain\Blat\Mail",
"SMTP server", "S", "")) Then
DoCmd.OpenForm "frmSMTP_Config"
Exit Sub
End If

If FlipAttache = True Then Exit Sub
Dim AttachList As String
Me!txtC.SetFocus

If IsNull(Me!txtC) Then
MsgBox "Le Message n'a pas t envoy ." & vbCrLf & vbCrLf & "Vous
devez sp cifier des destinataires pour le message.", vbExclamation,
"Messagerie"
Exit Sub
End If

If MsgBox("Confirmation de l'envoi du message ?", 4 + 32,
"Confirmation") = 7 Then Exit Sub
If Estvide(Me!txtMailSujet) Then
If MsgBox("Votre message ne comporte pas de sujet, voulez-vous
continuer ?", 4 + 32 + 256, "Confirmation") = 7 Then
Me!txtMailSujet.SetFocus
Exit Sub
End If
End If

If Estvide(Me!txtMailText) Then
If MsgBox("Votre message ne comporte pas de message, voulez-vous
continuer ?", 4 + 32 + 256, "Confirmation") = 7 Then
Me!txtMailText.SetFocus
Exit Sub
End If
End If

'Envois du courriel
DoCmd.Hourglass True

Call SendMail(Me!txtC, _
IIf(IsNull(Me!txtMailSujet), "", Me!txtMailSujet), _
IIf(IsNull(Me!txtMailText), "", Me!txtMailText), _
AttacheFiles, _
IIf(IsNull(Me!txtCc), "", Me!txtCc), _
IIf(IsNull(Me!txtCci), "", Me!txtCci), _
Me!lstPriority, _
Me!chkConfirmation)

DoCmd.Hourglass False
End Sub

Private Sub lstFiles_Click()
If Me!lstFiles.ListIndex = -1 Then
Me!cmdDelete.Enabled = False
Me!cmdOpen.Enabled = False
Me!cmdRenomer.Enabled = False
Else
Me!cmdOpen.Enabled = True
Me!cmdDelete.Enabled = True
Me!cmdRenomer.Enabled = True
End If

End Sub

Public Function OrderString(Str As String) As String
Dim i As Integer
Dim Separateur As Variant
Dim retValue As String
Dim Position As Integer
Dim OldPosition As Integer

'si aucune occurence
If InStr(1, Str, ",", vbTextCompare) = 0 Then
OrderString = Str
Exit Function
End If

retValue = ""

Position = 0
For i = 1 To 26
Do Until 1 = 2

Separateur = InStr(Position + 1, Str, ",")
If Position = 0 Then
If Asc(Left(Str, 1)) = i + 64 Then
retValue = retValue & IIf(retValue = "", "", ",") & Mid(Str, Position
+ 1, Separateur - 1)
End If
Position = Separateur
Else
If Asc(Mid(Str, Position + 1, 1)) = Val(i + 64) Then
If Separateur = 0 Then Separateur = Len(Str) + 1 'Si c'est la fin de
la chaine
retValue = retValue & IIf(retValue = "", "", ",") & Mid(Str, Position
+ 1, Separateur - Position - 1)
End If ...

read more »

On 29/10/2012 05:39:59, kduc wrote:

I am not sure that kd's solution is what the OP is after. I can't see how
each email has the correct invoice attached.

I was in a similar situation to the OP and my membership program basically
sends a personalised email to the main member of each family together with
the invoice which is generated just before the email is sent.

I can't send the code as it is tied up with numerous forms, but can on a
personal basis try to send tou bits of the database.

As a matter of interest, the same routine can send fixed internal reports,
mail merge documents, fixed external documents (pictures / letters etc) and
can use practically anything within the database as a source of the email

Phil

Le 29/10/2012 09:09, Phil a écrit :

Hi Phil,

How are you?

To send multiples mails with multiples invoices, put in a loop the
spelling of the table (or query) where are the adress and personalised
invoices with the call to the 'SendMail' function and optionaly fill a
table with results.

(I hope I understood your remark...)

--
kd

On 29/10/2012 20:37:06, kduc wrote:

Hi KD

Well thanks.

I was replying to the OP post (Rw Pearson) and had the impression that he was
working on a similar Club database to the one I have developed over the
years. The routinesI I wrote were in AK2000 (or maybe an earlier version of
Access) They still work and althogh there are more streamlined ways of doing
it. In Englisg we say "If it aint broke, don't fix it - Si ce n'est pas
cassé, ne le répare pas

Phil

I have found a copy of blat.dll and I am trying to test your code.  I have a
problem: the function ReadRegistry() is not defined.  Where is it?

thanks

David

Le 06/11/2012 01:22, David Hare-Scott a écrit :

The function is used to write the parameters of the server in the
registry file. The parameters must be set before the first send.

Because my bad English, I think the best I can do is sending to you a
base where I use 'blat' (to open with 'shift', the data file being not
présent).

<http://cjoint.com/?3KgrJX9a6XV>

(Four days valid.)

The function :

****************************************
Public Function EcrireRegistre(ByVal sTopKeyOrFile As String, ByVal
sSubKeyOrSection As String, _
        ByVal sValueName As String, ByVal sValueType As String, ByVal
vValue As Variant) As Long

Dim hKey                As Long
Dim lTopKey             As Long
Dim lOptions            As Long
Dim lsamDesired         As Long
Dim lHandle             As Long
Dim lDisposition        As Long
Dim lLenData            As Long
Dim lResult             As Long
Dim sClass              As String
Dim sValue              As String
Dim sSubKeyPath         As String
Dim bValue              As Boolean
Dim tSecurityAttributes As SECURITY_ATTRIBUTES

On Error GoTo fWriteValueError
lResult = 99
lTopKey = fTopKey(sTopKeyOrFile)
If lTopKey = 0 Then GoTo fWriteValueError

If lTopKey = 1 Then
    '
    ' Read the .ini file value.
    '
    If UCase$(sValueType) = "S" Then
        sValue = vValue
        lResult = WritePrivateProfileString(sSubKeyOrSection,
sValueName, sValue, sTopKeyOrFile)
    Else
        GoTo fWriteValueError
    End If
Else
    sClass = ""
    lOptions = REG_OPTION_NON_VOLATILE
    lsamDesired = KEY_CREATE_SUB_KEY Or KEY_SET_VALUE
    '
    ' Create the SubKey or open it if it exists. Return its handle.
    ' lDisposition will be REG_CREATED_NEW_KEY if the key did not exist.
    '
    lResult = RegCreateKeyEx(lTopKey, sSubKeyOrSection, 0, sClass,
lOptions, _
                  lsamDesired, tSecurityAttributes, lHandle, lDisposition)
    If lResult <> ERROR_SUCCESS Then GoTo fWriteValueError
    '
    ' Set the actual value.
    '
    If UCase$(sValueType) = "S" Then 'String value.
        sValue = vValue
        lLenData = Len(sValue) + 1
        lResult = RegSetValueEx(lHandle, sValueName, 0, REG_SZ, ByVal
sValue, lLenData)
    Else   'Boolean value.
        bValue = vValue
        lLenData = Len(bValue)
        lResult = RegSetValueEx(lHandle, sValueName, 0, REG_BINARY,
bValue, lLenData)
    End If
    '
    ' Close the key.
    '
    If lResult = ERROR_SUCCESS Then
        lResult = RegCloseKey(lHandle)
        EcrireRegistre = lResult
        Exit Function
    End If
End If
Exit Function
'
' Error processing.
'
fWriteValueError:
    MsgBox "Unable to write registry or .ini file value.",
vbExclamation, "fWriteValue"
    EcrireRegistre = lResult
End Function
****************************************************

--
kd

Thanks I will have a look at it and get back to you.

David

On 10/28/2012 12:48 PM, rwpear...@clear.net.nz wrote:

I use CDO to send the e-mail, and I attach the invoice as a PDF. So I
have a loop that loops through all the members, exporting their invoice
as a PDF, then creating an e-mail and attaching the PDF, the sending the
e-mail using CDO. It's very efficient, and is all contained within
Access. No external apps to use, and you have total control over the
process.

Neil