[AccessD] SendObject Attachments

Max:

Thanks for the code. It begins to look familiar.  I think I was going to go
this route once but the users would have had trouble configuring it because
they'd need to know their own  smtp server string and stuff like that.   

This will work for the instant application because it's only one site.
However, I'd have to create a form to allow each user to configure to their
won email and password.  (At this point, too, the client is looking for
cheap solutions). But the outlook stuff you sent earlier worked a treat.
Just too a couple minutes to mod for their site and walla! email with pdf
attachments.

Which attachments, BTW, I implemented in a hurry using the Lebans stuff,
thanks again to the list.

Thanks again to the list.

Did I mention how thankful I am to the list?

Best,

Rocky



 	
	

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of
max.wanadoo at gmail.com
Sent: Saturday, November 24, 2007 3:40 AM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] SendObject Attachments

Hi Rocky,
This should get you started with CDO.  Put your own parameters in - fairly
obvious where.
Max

Function RockyCDOTest()
  On Error GoTo errhandler
  Const conErr1 As String = "The server rejected one or more recipient
addresses. The server response was: 550 "
  Const conErr2 As String = "The server rejected one or more recipient
addresses. The server response was: 501 bad address syntax: <"
  Const ConErrX As String = "The transport failed to connect to the server"
  Const cdoReferenceTypeName = 1
  Dim strUserName As String, strPwd As String, strSMTPServer  As String,
strErr As String
  Dim objCDO, objBP
  Set objCDO = CreateObject("CDO.Message")    ' Create the message object.
  'Set objCDO = server.CreateObject("CDO.Message") ' alternative for
exchange I believe! Not tested
  objCDO.mimeformatted = True

  ' Sender/Email Contents/Details
  objCDO.from = "Rocky<rocky at rockydomain.com>"
  objCDO.To = "somebody at gmail.com"
  objCDO.cc = "person1 at domain.com;person2 at domain.com"
  objCDO.bcc = "person3 at domain.com"
  objCDO.Subject = "Testing 123"

  'body can be a string, or read from a file and can be text or html (Don't
use both)
  objCDO.HTMLBody = fFileContents("C:\body.html") ' or "C:\body.txt" '
create a test file

  ' Attachments
  objCDO.addattachment "C:\Att1.txt" ' create a test file
  objCDO.addattachment "C:\Att2.jpg" ' create a test file

  ' User SMTP login details
  strSMTPServer = "mail.rockydomain.org" ' send via this domain - can be IP
Address (sometimes this is smtp.mydomain.org)
  strUserName = "rocky" ' your user login name
  strPwd = "itsrockyletmein" ' your user login password

  ' SMTP Configuration Details
 
objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configura
tion/sendusing") = 2
 
objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configura
tion/smtpserver") = strSMTPServer
 
objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configura
tion/smtpauthenticate") = 1
 
objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configura
tion/sendusername") = strUserName
 
objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configura
tion/sendpassword") = strPwd
 
objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configura
tion/smtpserverport") = 25 'normally 25  but can be anything, try 587, or
465 or check with your ISP.
 
objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configura
tion/smtpusessl") = False
 
objCDO.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configura
tion/smtpconnectiontimeout") = 60 ' before timing out
  objCDO.Configuration.Fields.Update    ' Update configuration
  'MsgBox objCDO.GetStream.ReadText  ' Use to show the message.
  objCDO.Send  ' Send the message.
exithere:
  Exit Function
errhandler:
  strErr = "pfEmailByCDO - Send Errors " & Err.Description
  If InStr(strErr, ConErrX) > 0 Then
    strErr = strErr & " No Email Sent"
  End If
  MsgBox strErr
  GoTo exithere
End Function

Private Function fFileContents(strFilePath As String) As String
  ' Set a Reference for FileSystemObjects in Office 11.
  'These constants are defined to make the code more readable
  Const ForReading = 1, ForWriting = 2, ForAppending = 8
  Dim fso, f
  Set fso = CreateObject("Scripting.FileSystemObject")
  'Open the file for reading
  Set f = fso.OpenTextFile(strFilePath, ForReading)
  'The ReadAll method reads the entire file
  fFileContents = f.ReadAll
  f.Close    'Close the file
  Set f = Nothing
  Set fso = Nothing
End Function 


-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Rocky Smolin at
Beach Access Software
Sent: Friday, November 23, 2007 6:13 PM
To: 'Access Developers discussion and problem solving'
Subject: Re: [AccessD] SendObject Attachments

Thanks, Max.  Working the first solution at the moment.   If that works I'll
stop the clock, and go there to see if it works at their site.  

What's CDO?

Rocky


--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com

No virus found in this incoming message.
Checked by AVG Free Edition. 
Version: 7.5.503 / Virus Database: 269.16.5/1148 - Release Date: 11/23/2007
7:39 PM