Hi,
Try to use the code given in the following link:
http://info.abril.com.br/forum-antigo/forum.php?topico=146372
Or copy and paste the code in the NotePad to study it:
---------------------------------------------------
Private Sub Enviar_Click()
On Error GoTo sai
Dim lngRet As Long
Dim pula, contato, msg As String
Dim x, num As Integer
If Me.Todos = True Then GoTo ver
If IsNull(Me.Para) Or Me.Para = "" Then
MsgBox "Selecione o destinat?rio", , "Aten??o"
Me.Para.SetFocus
Exit Sub
ver:
ElseIf IsNull(Me.Assunto) Or Me.Assunto = "" Then
MsgBox "Coloque o assunto", , "Aten??o"
Me.Assunto.SetFocus
Exit Sub
ElseIf IsNull(Me.Mensagem) Or Me.Mensagem = "" Then
MsgBox "Entre com a Mensagem", , "Aten??o"
Me.Mensagem.SetFocus
Exit Sub
End If
If IsNull(Me.Cc) Then Me.Cc = ""
If IsNull(Me.Cco) Then Me.Cco = ""
If IsNull(Me.arquivo) Then Me.arquivo = ""
DoCmd.Hourglass True
contato = Me.Para.Column(1)
msg = "Prezado " & contato & ", " & Chr(10) & Chr(10) & Me.Mensagem
If Me.Todos = True Then
pula = "n?o"
GoTo 1
Else
pula = "sim"
GoTo 2
End If
1:
num = CDec(Me.Lista21.Column(0, 0))
x = 0
Do While x < num
Me.Para = ""
Me.Para = Me.Lista19.Column(0, x)
contato = Me.Para.Column(1)
msg = "Prezado " & contato & ", " & Chr(10) & Chr(10) & Me.Mensagem
2:
'Envia a mensagem
lngRet = SendMail((Me.Assunto), (Me.Para), "", "", (Me.arquivo), msg)
Select Case pula
Case "n?o": GoTo 3
Case "sim": GoTo 4
End Select
3:
x = x + 1
Loop
Me.Todos = False
MsgBox "Foram enviadas " & x & " mensagens com sucesso !!", vbInformation, "Envio de Mensagens"
GoTo 5
4:
MsgBox "Mensagem enviada com sucesso !!", vbInformation, "Envio de Mensagem"
GoTo 5
5:
'*************************************************
' Limpa todos os controle
'*************************************************
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is TextBox Then ctl = ""
Next ctl
DoCmd.Hourglass False
Me.Para = ""
Exit Sub
sai:
'Se ocorrer erro
If lngRet <> SUCCESS_SUCCESS Then
DoCmd.Beep
Select Case lngRet
Case 2
MsgBox "Error n?.: " & lngRet & ", ao enviar email." & vbCr & vbCr _
& "Verifique a origem do arquivo anexado. ", vbCritical, "ERRO"
Case 48
MsgBox "Error n?.: " & lngRet & ", ao enviar email." & vbCr & vbCr _
& "N?o foi poss?vel carregar MSOE.DLL", 16, "ERRO"
Case 453
MsgBox "Error n?.: " & lngRet & " (de MSAccess), ao enviar email." _
& vbCr & vbCr _
& "MAPI32X.DLL, n?o ? a vers?o correta.", vbCritical, "ERRO"
Case -2147467259
MsgBox "Error n?.: " & lngRet & ", ao enviar email." & vbCr & vbCr _
& "MAPI32.DLL, n?o ? a vers?o correta.", vbCritical, "ERRO"
Case Else
MsgBox "Erro ao enviar email: " & lngRet, vbCritical, "ERRO"
End Select
End If
DoCmd.Hourglass False
Me.Para = ""
End Sub
---------------------------------------------------
'*****************************************************
' FUNCION: SendMail
'
' PROPOSITO:
' Esta es la funci?n que interact?a directamente con MAPISendMail.
' Pasandole unas listas delimitadas por ";" de To, CC, CCO, y adjuntos,
' y un mensaje, la funci?n prepara las estructuras MapiRecip y MapiFile
' con la ayuda de ParseToken.
' Una vez preparadas las estructuras, llama a la API MAPISendMail para
' enviar el mensaje.
'
' PARAMETROS:
' sSubject: Es texto que aparecer? como Asunto del mensaje
' sTo: Lista delimitada por ";" con los destinatarios del mensaje.
' sCC: Lista de los destinatarios CC (Copia)
' sCCO: Lista de los destinatarios CCO (Copia oculta)
' sAttach: Lista de los ficheros a adjuntar al mensaje
'
' RETORNO
' SUCCESS_SUCCESS si no hay error, o el c?digo MAPI del error.
'*****************************************************
Function SendMail(sSubject As String, sTo As String, sCC As String, sCCO As String, _
sAttach As String, sMessage As String, sType As String)
On Error GoTo Err_CapturarError
Dim i, cTo, cCC, cCCO, cAttach ' contadores de items
Dim MAPI_Message As MAPIMessage
' Contar el n?mero de items en cada lista
cTo = CountTokens(sTo, ";")
cCC = CountTokens(sCC, ";")
cCCO = CountTokens(sCCO, ";")
cAttach = CountTokens(sAttach, ";")
' Dimensionar las matrices para las listas
ReDim rTo(0 To cTo) As String
ReDim rCC(0 To cCC) As String
ReDim rCCO(0 To cCCO) As String
ReDim rAttach(0 To cAttach) As String
' Pasar el contenido de las listas a las matrices
ParseTokens rTo(), sTo, ";"
ParseTokens rCC(), sCC, ";"
ParseTokens rCCO(), sCCO, ";"
ParseTokens rAttach(), sAttach, ";"
' Crear la estructura MAPI Recip para almacenar todos los destinatarios
ReDim MAPI_Recip(0 To cTo + cCC + cCCO - 1) As MapiRecip
' Cargar los "TO:" en la estructura
For i = 0 To cTo - 1
MAPI_Recip(i).Name = rTo(i)
MAPI_Recip(i).RecipClass = MAPI_TO
Next i
' Cargar los "CC:"
For i = 0 To cCC - 1
MAPI_Recip(cTo + i).Name = rCC(i)
MAPI_Recip(cTo + i).RecipClass = MAPI_CC
Next i
' Cargar los "CCO:"
For i = 0 To cCCO - 1
MAPI_Recip(cTo + cCC + i).Name = rCCO(i)
MAPI_Recip(cTo + cCC + i).RecipClass = MAPI_CCO
Next i
' Crear la estructura MAPI_File para los adjuntos
ReDim MAPI_File(0 To cAttach) As MapiFile
' Cargar los adjuntos en la estructura
MAPI_Message.FileCount = cAttach
For i = 0 To cAttach - 1
MAPI_File(i).Position = -1
MAPI_File(i).PathName = rAttach(i)
Next i
' Llenar los campos del mensaje
MAPI_Message.Subject = sSubject
MAPI_Message.NoteText = sMessage
'MAPI_Message.RichText = sMessage
MAPI_Message.MessageType = sType
MAPI_Message.RecipCount = cTo + cCC + cCCO
' Enviar el mensaje
SendMail = MAPISendMail(0&, 0&, MAPI_Message, MAPI_Recip(), _
MAPI_File(), MAPI_LOGON_UI, 0&)
Salida:
Exit Function
Err_CapturarError:
Select Case Err.Number
Case 48
'Error: No se encontr? el archivo: C:Archivos de programa _
Outlook ExpressMsoe.dll
SendMail = 48
Case 453
'Error: Imposible encontra el punto de entrada de DLL BMAPISendMail en _
MAPI32X.DLL
'Asignar el n?mero de error. El filtro y el mensaje m?s adelante.
SendMail = 453
Case Else
'Cazar todos aquellos errores inesperados.
MsgBox Err.Number & " " & Err.Description
End Select
Resume Salida 'Salida a otro procedimiento.
End Function
---------------------------------------------------
biganthony via AccessMonster.com wrote:
Send Email By outlook Express from MS Access
03-Dec-07
Hi,
I am using Lyle Fairfield's code for sending an email via Outlook Express
from Access 2003. (thank you Lyle)
I wrote a small application for someone who has two computers - one Windows
XP x64 and the other Windows 32 bit. They run the small database on both
computers at home (depending which one the kids are on). Having added the
ability to email, I have now met a problem where the location of the Outlook
Express program differs between the two computers:
On the x64 computer, it is: "C:\Program Files (x86)\Outlook Express\msoe.dll"
and on the 32 bit Windows it is: "C:\Program Files\Outlook Express\msoe.dll"
Is there a way in Lyle's code below to determine where the Outlook Express
program is? The code that I have the problem with is the following (it is for
the XP x64 computer):
***********Begin Code ****************
Declare Function MAPISendMail _
Lib "C:\Program Files (x86)\Outlook Express\msoe.dll" ( _
ByVal Session As Long, _
ByVal UIParam As Long, _
Message As MAPIMessage, _
ByVal flags As Long, _
ByVal Reserved As Long) As Long
**********End Code *********************
The person using the database does not want to use Outlook, that is why they
are using Outlook Express and the laptop they use at work has GroupWise as
the default email client (which I have used the GroupWise class to send mail).
Besides talking him into using Outlook, is there anyway in code to account
for the different locations of Outlook Express between the two editions of XP?
Or do I just tell him to use it on one machine?
I would appreciate any advice.
Thanks
Anthony
--
Previous Posts In This Thread:
Send Email By outlook Express from MS Access
Hi,
I am using Lyle Fairfield's code for sending an email via Outlook Express
from Access 2003. (thank you Lyle)
I wrote a small application for someone who has two computers - one Windows
XP x64 and the other Windows 32 bit. They run the small database on both
computers at home (depending which one the kids are on). Having added the
ability to email, I have now met a problem where the location of the Outlook
Express program differs between the two computers:
On the x64 computer, it is: "C:\Program Files (x86)\Outlook Express\msoe.dll"
and on the 32 bit Windows it is: "C:\Program Files\Outlook Express\msoe.dll"
Is there a way in Lyle's code below to determine where the Outlook Express
program is? The code that I have the problem with is the following (it is for
the XP x64 computer):
***********Begin Code ****************
Declare Function MAPISendMail _
Lib "C:\Program Files (x86)\Outlook Express\msoe.dll" ( _
ByVal Session As Long, _
ByVal UIParam As Long, _
Message As MAPIMessage, _
ByVal flags As Long, _
ByVal Reserved As Long) As Long
**********End Code *********************
The person using the database does not want to use Outlook, that is why they
are using Outlook Express and the laptop they use at work has GroupWise as
the default email client (which I have used the GroupWise class to send mail).
Besides talking him into using Outlook, is there anyway in code to account
for the different locations of Outlook Express between the two editions of XP?
Or do I just tell him to use it on one machine?
I would appreciate any advice.
Thanks
Anthony
--
I'm surprised you haven't gotten an answer after this long -- things usually
I'm surprised you haven't gotten an answer after this long -- things usually
move faster on this site. Two suggestions:
Use FindFile. Look in one location, if successful, store the appropriate
file path and name to a variable; if not successful, look in the other
location and do ditto. If both fail, display an Aw Shucks messagebox or
handle the error in whatever other way you see fit.
Plan B: Search your entire c:\ drive for msoe.dll; when found, store the
resulting filepathname in your variable, and use that string as appropriate
in your EMailing code. If you're not sure how to do that, I think I have a
little WhereIsExcel() function somewhere that I can post for you.
:
Thanks Larry for replying.I have been absent will ilness.
Thanks Larry for replying.
I have been absent will ilness. I will try to use your ideas. Anyway I would
appreciate having a look at that WhereIsExcel() function you mention below.
Thanks
Anthony
LarryP wrote:
--
Message posted via AccessMonster.com
Okay, here's "Where Is Excel.
Okay, here's "Where Is Excel." It's set up to assume two specific versions
of MSOffice are in specific, standard locations, but the guts of it is Case
Else, where it goes looking for the .exe anywhere else on the c:\ drive.
With minor modifications, you can use that bit of code to file your .dll, or
any other file.
Public Function WhereIsExcel() As String
'Useful for confirming the location of Excel.exe when it needs to be
launched from Access via VBA. (It can be in different places
'depending on the version of MSOffice. Also works for other MSOffice
component by substituting MSAccess.exe, etc.
Select Case Application.Version
Case "11.0":
WhereIsExcel = "C:\Program Files\Microsoft Office\OFFICE11\EXCEL.exe"
Case "10.0":
WhereIsExcel = "C:\Program Files\Microsoft Office\OFFICE10\EXCEL.exe"
Case Else:
With Application.FileSearch
.NewSearch
.LookIn = "C:\"
.SearchSubFolders = True
.Filename = "Excel.exe"
.MatchTextExactly = True
If .Execute() > 0 Then
WhereIsExcel = .FoundFiles(1)
End If
End With
End Select
End Function
:
Thanks Larry - I'll have a go with it.Appreciate your willingness to share.
Thanks Larry - I'll have a go with it.
Appreciate your willingness to share.
Anthony
LarryP wrote:
--
Message posted via AccessMonster.com
Submitted via EggHeadCafe - Software Developer Portal of Choice
Sets of "101 Code Samples" for Visual Studio and SQL Server
http://www.eggheadcafe.com/tutorial...3b-73eaff4e5881/sets-of-101-code-samples.aspx