Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
Emailing out invoices
93 views
Skip to first unread message
rwpe...@clear.net.nz
Oct 28, 2012, 1:48:28 PM10/28/12
to
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.
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.
kduc
Oct 28, 2012, 6:04:54 PM10/28/12
to
David Hare-Scott
Oct 28, 2012, 8:12:28 PM10/28/12
to
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
David Hare-Scott
Oct 28, 2012, 11:45:17 PM10/28/12
to
kduc wrote:
> Le 28/10/2012 18:48, rwpe...@clear.net.nz a �crit :
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 28/10/2012 18:48, rwpe...@clear.net.nz a �crit :
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
kduc
Oct 29, 2012, 1:39:58 AM10/29/12
to
Le 29/10/2012 04:45, David Hare-Scott a �crit :
>> I use Blat :
>>
>> <http://oldsite.blat.net/>
>
> 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?
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
Position = Separateur
End If
If Position > Len(Str) Or Position = 0 Then
Position = 0
Exit Do
End If
Loop
Next
OrderString = retValue
End Function
Public Function ClickCadre(ctlActif As String)
Me!cdrC.BackColor = 15651521
Me!cdrCc.BackColor = 15651521
Me!cdrCci.BackColor = 15651521
Me!cdrAttache.BackColor = 15651521
Me!cdrConfig.BackColor = 15651521
Me(ctlActif).BackColor = 14857624
ModeSelected = ctlActif
End Function
Private Function FlipCadre(ctlActif As String)
If Me!cdrC.Visible = True Then Me!cdrC.Visible = False
If Me!cdrCc.Visible = True Then Me!cdrCc.Visible = False
If Me!cdrCci.Visible = True Then Me!cdrCci.Visible = False
If Me!cdrAttache.Visible = True Then Me!cdrAttache.Visible = False
If Me!cdrConfig.Visible = True Then Me!cdrConfig.Visible = False
If ctlActif = "All" Then
Me(ModeSelected).Visible = True
Else
Me(ctlActif).Visible = True
End If
End Function
Public Sub FlipJoindre(EstVisible As Boolean)
Me!FlagFocus.SetFocus
If EstVisible = False Then GoTo OffAttache
If FlipAttache = False Then
FlipAttache = True
Me!lblFiles.Visible = True
Me!cdrFiles.Visible = True
Me!lstFiles.Visible = True
Me!cmdBrowse.Visible = True
Me!cmdDelete.Visible = True
Me!cmdOpen.Visible = True
Me!cmdRenomer.Visible = True
Me!txtMailText.Locked = True
Me!txtMailText.Enabled = False
Me!txtC.Enabled = False
Me!txtC.Locked = True
Me!txtCci.Enabled = False
Me!txtCc.Locked = True
Me!txtCc.Enabled = False
Me!txtCci.Locked = True
Me!txtCci.Enabled = False
Me!txtMailSujet.Locked = True
Me!txtMailSujet.Enabled = False
Me!cmdMask.Visible = True
Else
OffAttache:
FlipAttache = False
Me!lblFiles.Visible = False
Me!cdrFiles.Visible = False
Me!lstFiles.Visible = False
Me!cmdBrowse.Visible = False
Me!cmdDelete.Visible = False
Me!cmdOpen.Visible = False
Me!cmdRenomer.Visible = False
Me!txtMailText.Locked = False
Me!txtMailText.Enabled = True
Me!txtC.Locked = False
Me!txtC.Enabled = True
Me!txtCc.Locked = False
Me!txtCc.Enabled = True
Me!txtCci.Locked = False
Me!txtCci.Enabled = True
Me!txtMailSujet.Locked = False
Me!txtMailSujet.Enabled = True
Me!cmdMask.Visible = False
End If
End Sub
Public Function AttacheFiles() As String
'Concat�ne les fichiers
Dim i As Long
Dim retValue As String
For i = 0 To Me.lstFiles.ListCount - 1
retValue = retValue & Me!lstFiles.ItemData(i) & ","
Next i
AttacheFiles = Chr(34) & retValue & Chr(34)
End Function
Private Sub lstPriority_AfterUpdate()
Me!FlagFocus.SetFocus
Me!lstPriority.Visible = False
Me!BoxPriority.Visible = False
Select Case Me!lstPriority.Column(0)
Case 1 'Haute
Me!lblProrit�.Visible = True
Me.lblProrit�.Caption = Space(8) & "Ce message � une priorit� haute."
Me!imgBas.Visible = False
Me!imgHaut.Visible = True
Case 2 'Normal
If FirstOpen = True Then
FirstOpen = False
Else
Me!lblProrit�.Visible = False
Me!imgBas.Visible = False
Me!imgHaut.Visible = False
End If
Case 0 'Basse
Me!lblProrit�.Visible = True
Me.lblProrit�.Caption = Space(8) & "Ce message � une priorit� basse."
Me!imgBas.Visible = True
Me!imgHaut.Visible = False
End Select
End Sub
Public Function MaskPriority()
Me!lstPriority.Visible = False
Me!BoxPriority.Visible = False
End Function
--
kd
>> I use Blat :
>>
>> <http://oldsite.blat.net/>
>
> 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?
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
Position = Separateur
End If
If Position > Len(Str) Or Position = 0 Then
Position = 0
Exit Do
End If
Loop
Next
OrderString = retValue
End Function
Public Function ClickCadre(ctlActif As String)
Me!cdrC.BackColor = 15651521
Me!cdrCc.BackColor = 15651521
Me!cdrCci.BackColor = 15651521
Me!cdrAttache.BackColor = 15651521
Me!cdrConfig.BackColor = 15651521
Me(ctlActif).BackColor = 14857624
ModeSelected = ctlActif
End Function
Private Function FlipCadre(ctlActif As String)
If Me!cdrC.Visible = True Then Me!cdrC.Visible = False
If Me!cdrCc.Visible = True Then Me!cdrCc.Visible = False
If Me!cdrCci.Visible = True Then Me!cdrCci.Visible = False
If Me!cdrAttache.Visible = True Then Me!cdrAttache.Visible = False
If Me!cdrConfig.Visible = True Then Me!cdrConfig.Visible = False
If ctlActif = "All" Then
Me(ModeSelected).Visible = True
Else
Me(ctlActif).Visible = True
End If
End Function
Public Sub FlipJoindre(EstVisible As Boolean)
Me!FlagFocus.SetFocus
If EstVisible = False Then GoTo OffAttache
If FlipAttache = False Then
FlipAttache = True
Me!lblFiles.Visible = True
Me!cdrFiles.Visible = True
Me!lstFiles.Visible = True
Me!cmdBrowse.Visible = True
Me!cmdDelete.Visible = True
Me!cmdOpen.Visible = True
Me!cmdRenomer.Visible = True
Me!txtMailText.Locked = True
Me!txtMailText.Enabled = False
Me!txtC.Enabled = False
Me!txtC.Locked = True
Me!txtCci.Enabled = False
Me!txtCc.Locked = True
Me!txtCc.Enabled = False
Me!txtCci.Locked = True
Me!txtCci.Enabled = False
Me!txtMailSujet.Locked = True
Me!txtMailSujet.Enabled = False
Me!cmdMask.Visible = True
Else
OffAttache:
FlipAttache = False
Me!lblFiles.Visible = False
Me!cdrFiles.Visible = False
Me!lstFiles.Visible = False
Me!cmdBrowse.Visible = False
Me!cmdDelete.Visible = False
Me!cmdOpen.Visible = False
Me!cmdRenomer.Visible = False
Me!txtMailText.Locked = False
Me!txtMailText.Enabled = True
Me!txtC.Locked = False
Me!txtC.Enabled = True
Me!txtCc.Locked = False
Me!txtCc.Enabled = True
Me!txtCci.Locked = False
Me!txtCci.Enabled = True
Me!txtMailSujet.Locked = False
Me!txtMailSujet.Enabled = True
Me!cmdMask.Visible = False
End If
End Sub
Public Function AttacheFiles() As String
'Concat�ne les fichiers
Dim i As Long
Dim retValue As String
For i = 0 To Me.lstFiles.ListCount - 1
retValue = retValue & Me!lstFiles.ItemData(i) & ","
Next i
AttacheFiles = Chr(34) & retValue & Chr(34)
End Function
Private Sub lstPriority_AfterUpdate()
Me!FlagFocus.SetFocus
Me!lstPriority.Visible = False
Me!BoxPriority.Visible = False
Select Case Me!lstPriority.Column(0)
Case 1 'Haute
Me!lblProrit�.Visible = True
Me.lblProrit�.Caption = Space(8) & "Ce message � une priorit� haute."
Me!imgBas.Visible = False
Me!imgHaut.Visible = True
Case 2 'Normal
If FirstOpen = True Then
FirstOpen = False
Else
Me!lblProrit�.Visible = False
Me!imgBas.Visible = False
Me!imgHaut.Visible = False
End If
Case 0 'Basse
Me!lblProrit�.Visible = True
Me.lblProrit�.Caption = Space(8) & "Ce message � une priorit� basse."
Me!imgBas.Visible = True
Me!imgHaut.Visible = False
End Select
End Sub
Public Function MaskPriority()
Me!lstPriority.Visible = False
Me!BoxPriority.Visible = False
End Function
--
kd
Phil
Oct 29, 2012, 4:09:01 AM10/29/12
to
On 29/10/2012 05:39:59, kduc wrote:
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 04:45, David Hare-Scott a écrit :
>
>>> I use Blat :
>>>
>>> <http://oldsite.blat.net/>>
>> 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?
I am not sure that kd's solution is what the OP is after. I can't see how
>
>>> I use Blat :
>>>
>>> <http://oldsite.blat.net/>>
>> 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?
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
kduc
Oct 29, 2012, 4:37:07 PM10/29/12
to
Le 29/10/2012 09:09, Phil a écrit :
> 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.
Hi Phil,
> 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.
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
Phil
Oct 29, 2012, 4:56:45 PM10/29/12
to
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
David Hare-Scott
Nov 5, 2012, 7:22:18 PM11/5/12
to
kduc wrote:
problem: the function ReadRegistry() is not defined. Where is it?
thanks
David
> Le 29/10/2012 04:45, David Hare-Scott a écrit :
>
>>> I use Blat :
>>>
>>> <http://oldsite.blat.net/>
>>
>> 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?
>
> 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.
>
I have found a copy of blat.dll and I am trying to test your code. I have a
>
>>> I use Blat :
>>>
>>> <http://oldsite.blat.net/>
>>
>> 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?
>
> 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.
>
problem: the function ReadRegistry() is not defined. Where is it?
thanks
David
kduc
Nov 6, 2012, 11:49:20 AM11/6/12
to
Le 06/11/2012 01:22, David Hare-Scott a écrit :
> 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?
The function is used to write the parameters of the server in the
> 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?
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
David Hare-Scott
Nov 6, 2012, 6:14:37 PM11/6/12
to
kduc wrote:
> Le 06/11/2012 01:22, David Hare-Scott a écrit :
>
>> 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?
>
> 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.)
>
Thanks I will have a look at it and get back to you.
> Le 06/11/2012 01:22, David Hare-Scott a écrit :
>
>> 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?
>
> 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.)
>
David
Neil
Nov 16, 2012, 9:26:57 AM11/16/12
to
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
0 new messages