Link to home
Start Free TrialLog in
Avatar of schmir1
schmir1Flag for United States of America

asked on

CDO Replacement e-mail for Access Front-end

My Access 2007 database (front-end) automatically sends e-mail based on user actions.  I am looking for a replacement to this e-mail SendObject system because my company is going to Win7/Office 2010.  CDO (Collaboration Data Objects) will not work with Outlook 2010.  Below are the main parts of SendObject.

Requirements:
I need a VBA replacement that will be able to send e-mail from PCs with WinXP/Outlook 2003 and also work on Win7/Outlook 2010 machines.  We will have both types of PCs for some time to come.  

System should be writable in Access 2007 or Access 2010 VBA.

I would like to able to implement this e-mail system without having to install software on my users PCs.  So basically, is there a native system that I can use and would be already on my users PCs.

It would be nice if there was a way to look at what was sent.  Currently, I can look in my Sent Items folder to see everything my DB sent.

I do currently send attachments but this is not a deal breaker.

What would be the best way to go?

Option Compare Database
Option Explicit
 
Private MAPISession As MAPI.Session
Private MAPIMessage As Message
Private MAPIRecipient As MAPI.Recipient
Private MAPIAttachment As MAPI.Attachment
Private reciparray
Private strFileName As String


Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4
Private Const HKEY_CURRENT_USER = &H80000001
Private Const ERROR_NONE = 0
Private Const KEY_ALL_ACCESS = &H3F

Private Declare Function GetVersionEx Lib "kernel32" _
   Alias "GetVersionExA" _
         (ByRef lpVersionInformation As OSVERSIONINFO) As Long


Private Declare Function RegCloseKey Lib "advapi32.dll" _
         (ByVal hKey As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
   Alias "RegOpenKeyExA" _
         (ByVal hKey As Long, _
         ByVal lpSubKey As String, _
         ByVal ulOptions As Long, _
         ByVal samDesired As Long, _
         phkResult As Long) As Long

Private Declare Function RegQueryValueExString Lib "advapi32.dll" _
   Alias "RegQueryValueExA" _
         (ByVal hKey As Long, _
         ByVal lpValueName As String, _
         ByVal lpReserved As Long, _
         lpType As Long, _
         ByVal lpData As String, _
         lpcbData As Long) As Long

Private Declare Function RegQueryValueExLong Lib "advapi32.dll" _
   Alias "RegQueryValueExA" _
         (ByVal hKey As Long, _
         ByVal lpValueName As String, _
         ByVal lpReserved As Long, _
         lpType As Long, lpData As Long, _
         lpcbData As Long) As Long
 
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" _
   Alias "RegQueryValueExA" _
         (ByVal hKey As Long, _
         ByVal lpValueName As String, _
         ByVal lpReserved As Long, _
         lpType As Long, _
         ByVal lpData As Long, _
         lpcbData As Long) As Long
         
Private Declare Function GetTempPath Lib "kernel32" _
         Alias "GetTempPathA" (ByVal nBufferLength As Long, _
         ByVal lpBuffer As String) As Long

Public Enum accSendObjectOutputFormat
    accOutputRTF = 1
    accOutputTXT = 2
    accOutputSNP = 3
    accOutputXLS = 4
    accOutputHTML = 5
End Enum

Public Sub SendObject(Optional ObjectType As Access.AcSendObjectType = acSendNoObject, _
                      Optional ObjectName, _
                      Optional OutputFormat As accSendObjectOutputFormat, _
                      Optional EmailAddress, _
                      Optional CC, _
                      Optional BCC, _
                      Optional Subject, _
                      Optional MessageText, _
                      Optional EditMessage)
'Example: clsSendObject.SendObject intFormType, strForm, acFormatHTML, strName, , , strSubject, strMessage, False   'HTML=easier to read
'docmd.sendobject  acSendNoObject,xxx,xxx,
    
    Dim strTmpPath As String * 512
    Dim sTmpPath As String
    Dim strExtension As String
    Dim nRet As Long

    StartMessagingAndLogon
    Set MAPIMessage = MAPISession.Outbox.Messages.Add
    If ObjectType <> -1 Then  'acSendNoObject
        If IsMissing(ObjectName) Or IsMissing(OutputFormat) Then
            LogEvt "The object type, name, or output format is not valid. Cannot send message.", vbCritical, "Email Problem (ASO-2)"
            MAPISession.Outbox.Messages.Delete
            GoTo accSendObject_Exit
        Else
            strExtension = GetExtension(OutputFormat)
            nRet = GetTempPath(512, strTmpPath)
            If (nRet > 0 And nRet < 512) Then
                If InStr(strTmpPath, Chr(0)) > 0 Then
                    
                    sTmpPath = RTrim(Left(strTmpPath, InStr(1, strTmpPath, Chr(0)) - 1))
                End If
                strFileName = sTmpPath & ObjectName & strExtension
            End If
            On Error Resume Next
            DoCmd.OutputTo ObjectType, ObjectName, GetOutputFormat(OutputFormat), strFileName, False
            
            If Err.Number = 0 Then
                Set MAPIAttachment = MAPIMessage.Attachments.Add
                With MAPIAttachment
                    .Name = ObjectName
                    .Type = CdoFileData
                    .Source = strFileName
                End With
                Kill strFileName
              
            Else
                LogEvt "The object type, name, or output format is not valid. Cannot send message.", vbCritical, "Email Problem (ASO-1)"
                MAPISession.Outbox.Messages.Delete
                GoTo accSendObject_Exit
            End If
        End If
    End If
    
    If Not IsMissing(EmailAddress) Then
        reciparray = Split(EmailAddress, ";", -1, vbTextCompare)
        ParseAddress CdoTo
        Erase reciparray
    End If
    If Not IsMissing(CC) Then
        reciparray = Split(CC, ";", -1, vbTextCompare)
        ParseAddress CdoCc
        Erase reciparray
    End If
    
    If Not IsMissing(BCC) Then
        reciparray = Split(BCC, ";")
        ParseAddress CdoBcc
        Erase reciparray
    End If
    
    If Not IsMissing(Subject) Then
        MAPIMessage.Subject = Subject
    End If
    
    If Not IsMissing(MessageText) Then
        MAPIMessage.Text = MessageText
    End If
    
    If IsMissing(EditMessage) Then EditMessage = True
    
    MAPIMessage.Update
    MAPIMessage.Send savecopy:=True, ShowDialog:=EditMessage
        
accSendObject_Exit:
    'Log off the MAPI session.
    MAPISession.Logoff
    Set MAPIAttachment = Nothing
    Set MAPIRecipient = Nothing
    Set MAPIMessage = Nothing
    Set MAPISession = Nothing
    Exit Sub

End Sub

Private Sub StartMessagingAndLogon()
    Dim sKeyName As String
    Dim sValueName As String
    Dim sDefaultUserProfile As String
    Dim osinfo As OSVERSIONINFO
    Dim retvalue As Integer
    
    On Error GoTo ErrorHandler
    Set MAPISession = CreateObject("MAPI.Session")
    
    'Try to log on.  If this fails, the most likely reason is
    'that you do not have an open session.  The error
    '-2147221231  MAPI_E_LOGON_FAILED returns.  Trap
    'the error in the ErrorHandler.
    MAPISession.Logon ShowDialog:=False, NewSession:=False
    Exit Sub

ErrorHandler:
    Select Case Err.Number
       Case -2147221231  'MAPI_E_LOGON_FAILED
          'Need to determine what operating system is in use. The keys are different
          'for WinNT and Win95.
          osinfo.dwOSVersionInfoSize = 148
          osinfo.szCSDVersion = Space$(128)
          retvalue = GetVersionEx(osinfo)
          Select Case osinfo.dwPlatformId
             Case 0   'Unidentified
                LogEvt "Unidentified Operating System.  Cannot log on to messaging.", vbCritical, "Email Problem (ASO-3)"
                Exit Sub
             Case 1   'Win95
                sKeyName = "Software\Microsoft\" & _
                           "Windows Messaging " & _
                           "Subsystem\Profiles"
    
             Case 2   'NT
                 sKeyName = "Software\Microsoft\Windows NT\" & _
                            "CurrentVersion\" & _
                            "Windows Messaging Subsystem\Profiles"
          End Select
    
          sValueName = "DefaultProfile"
          sDefaultUserProfile = QueryValue(sKeyName, sValueName)
          MAPISession.Logon ProfileName:=sDefaultUserProfile, _
                           ShowDialog:=False
          Exit Sub
       Case Else
          LogEvt "An error has occured while trying" & Chr(10) & _
          "to create and to log on to a new ActiveMessage session." & _
          Chr(10) & "Report the following error to your " & _
          "System Administrator." & Chr(10) & Chr(10) & _
          "Error Location: frmMain.StartMessagingAndLogon" & _
          Chr(10) & "Error Number: " & Err.Number & Chr(10) & _
          "Description: " & Err.Description, vbCritical, "Email Problem (ASO-4)"
    End Select
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Jim Dettman (EE MVE)
Jim Dettman (EE MVE)
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of schmir1

ASKER

Have you used it.  I can't get the example to run.  I get the following error:
Your attempt to send mail failed for the following reason(s):
Valid name, no data record of requested type


<<Have you used it.  I can't get the example to run.  I get the following error:>>

  Yup, have used it for years.

<<Your attempt to send mail failed for the following reason(s):
Valid name, no data record of requested type>>

  Not sure what that is.  Did you look at the sample code on the page?  Here it is:

'Module Level Declaration (WithEvents optional but recommended)
Private WithEvents poSendMail as vbSendMail.clsSendMail
Private Sub cmdSend_Click()
'Assumes you have a form with text boxes named as below

set poSendMail = new vbSendMail.clsSendMail
poSendMail.SMTPHost = txtServer.Text
poSendMail.From = txtFrom.Text
poSendMail.FromDisplayName = txtFromName.Text
poSendMail.Recipient = txtTo.Text
poSendMail.RecipientDisplayName = txtToName.Text
poSendMail.ReplyToAddress = txtFrom.Text
poSendMail.Subject = txtSubject.Text
poSendMail.Attachment = txtFileName.text 'attached file name
poSendMail.Message = txtMsg.Text
poSendMail.Send
set poSendMail = nothing
End Sub

  Very straight forward.  Past that into a sub, then call the sub.  Put a STOP at the top of the sub, then use F8 to step through the code making sure you assign something to each (except the attachment, which you can comment out).  Use literal strings in place of the control references.  

 If you can't get that to work, I'll work up a sample DB.

JimD.

I've taken to using vbMAPI from www.everythingaccess.com. It's not free, but it works very well and requires no installation on the enduser PC (it's all contained in the Access project's VBA code). It bypasses security warnings and such, and allows you very easy methods to work directly with Outlook.
Avatar of schmir1

ASKER

JDettman:
  I'm just trying to run the SendMailExample.vbg VB example that has a form to fill out.  I went to a DOS box and got the SMTP Server name but I can't get it to send a test message.  I ask my company for the SMTP server name and they gave me another name but that doesn't work.  Do I need a POP login?  If so, how do I figure out my POP Server?

Note:  Here is the error that I get no matter how I fill out the form:
Your attempt to send mail failed for the following reason(s):
Valid name, no data record of requested type

Avatar of schmir1

ASKER

LSMConsulting:
Will vbMAPI work on systems with Outlook 2003 and also on systems with Outlook 2010?
According to the website, it will work with any version, including 2010.
<<  I'm just trying to run the SendMailExample.vbg VB example that has a form to fill out.  I went to a DOS box and got the SMTP Server name but I can't get it to send a test message.  I ask my company for the SMTP server name and they gave me another name but that doesn't work.  Do I need a POP login?  If so, how do I figure out my POP Server?>>

  I did a little checking on that error message and it sounds like the DNS setup is not correct (can't locate a MX record for the server you named).  Instead of a server name, try using the IP address of the SMTP server.  That will bypass DNS.

  As far as a POP login, that depends on the setting of the mail server.  Some SMTP servers require a pop login before they'll allow you to send.  Others may require SMTP authentication.  What your sever requires you can discover by checking the account setup in Outlook, by using "mail" from Control Panel, or asking your admin what the settings are (I'd check a mail client though if you've got one configured on that station).

JimD.

JimD.
Avatar of schmir1

ASKER

JDettman:
  I finally got the correct SMTP server from my MIT people.  They first gave me my SMTP email address which didn't work.  Before that I tried ping mail.mysite.com which return a name and IP both of which didn't work.  Anyhow, now I can get the example form to send e-mail.

  One more question I have is "How do I attach the DLL to my DB?"
<<One more question I have is "How do I attach the DLL to my DB?" >>

 open a module in design view, click tools/references.  Scroll down the reference list to "SMTP Send mail for VB 6.0" and check it.  Looks like this:

 User generated image
 If it doesn't appear in the reference list, then you need to regesiter it.  Drop down to a command prompt and type:

 C:\Windows\System32\Regsrv32  "C:\...\vbSendMail.DLL"

  making sure you use the appropriate path.

JimD.
Avatar of schmir1

ASKER

I'm going to need to add some VBScript to my DB setup file to do this for all my users.  I'm wondering if I'm going to have some security issues?  Also, some of my users are on Win7 and is this script going to work for them?

I did find an Distirbution Section in the manual.  See below:
Is mswinsck.ocx going to already be on my user's PCs (WinXP and Win7)?  I can find it on my WinXP PC but not my Win7 PC.
Distribution Issues

The following two files MUST be installed and properly registered on any target machine where you intend to run vbSendMail:
1.	vbSendMail.dll
2.	mswinsck.ocx

Open in new window

<<I'm going to need to add some VBScript to my DB setup file to do this for all my users.  I'm wondering if I'm going to have some security issues?  Also, some of my users are on Win7 and is this script going to work for them?>>

  or a batch file, or an install package.  Script, batch, or install should work fine as long as they do a run as administrator.  

  If security is going to be a major issue for you, an alternative is BLAT.  Again this is software that talks directly to a SMTP server, but it doesn't has as many bells and whistles as vbSendMail.  There is a DLL floating around of that, but the command line interface (which you can shell() to) is the most up to date.  In fact there is a class you can drop into Access here:

http://www.blat.net/newdocs/MSAccess_class.html

  which calls the .EXE.  That's just like calling any other external program.

<<Is mswinsck.ocx going to already be on my user's PCs (WinXP and Win7)?  I can find it on my WinXP PC but not my Win7 PC.>>

  Totally forgot about the mswinsck.ocx.  I've primarly use it under XP, but I've got a couple of clients with Win 7 stations and I don't remember any issues.

JimD.
Avatar of schmir1

ASKER

VBSendMail looks so easy that I'm going to pursue it.  I'm trying to set up a VBscript to register the DLL and am having trouble.  I'll also open another question because I'm getting into another area.  Anyhow, here is the script.  I get an error on line 6, col 1 (the system cannot find the file specified).
'regsvr32 shmedia.dll for installing a file
'regsvr32 /u shmedia.dll for uninstalling a file
dim WshShell
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.run "C:\Windows\System32\Regsrv32 C:\Projects\DTLDB\DTLDB_Pro_Beta\vbSendMail.DLL"

Open in new window

Try:

WshShell.run "C:\Windows\System32\Regsvr32.EXE C:\Projects\DTLDB\DTLDB_Pro_Beta\vbSendMail.DLL"

JimD.
Avatar of schmir1

ASKER

That runs on my WinXP PC but I get this error on my Win7PC:
    Call to DLLRegisterServer failed with error code 0x80004005
<<Call to DLLRegisterServer failed with error code 0x80004005 >>

 That's typically from UAC and that your not running the command as admin mode.  I'm not sure how you'd get around that with a script.

JimD.
Avatar of schmir1

ASKER

OK.  I'm still working on it.  There is some help around on how to run script as admin.  Will let you know.
<<OK.  I'm still working on it.  There is some help around on how to run script as admin.  Will let you know. >>

  OK.  And apologies for leading you down the path a bit. It's been so long since I did that vbSendMail setup, I forgot that the DLL actually had to be registered.  In some cases, you simply need to place a DLL in the app directory to get it to work, and I had been discussing that in other questions recently.

  Using vbSendMail or something like it is as simple as it gets with sending mail.  All you need is the server address (which you can auto discover in some cases), an account, and a password.  And the last you might not even need if the server accepts un-authorized mail from the internal network.

JimD.
Avatar of schmir1

ASKER

It's OK because I need to learn how to run script as administrator anyway for my normal installation script to work.  I've got another question that hopefully will help me with this.

I'm hoping I don't need a password because some of the e-mail is sent automatically at night.  I ran the sample program on my XP PC and it worked without a password.  I can't run the sample program on my Win7 PC because it don't have VB Studio on it yet.  

Change is always a struggle but I'm hoping that it won't kill me.  If nothing else, I'll have to go around to about 40 PCs and manually set them up.
<<I'm hoping I don't need a password because some of the e-mail is sent automatically at night.  I ran the sample program on my XP PC and it worked without a password.  I can't run the sample program on my Win7 PC because it don't have VB Studio on it yet.  >>

  The requiring of a password is dependent on the mail server.  But if it does, the easy way around that is to just set up a special account on the server for sending mail (ie. AutoEmail@....COM) and a password.  Then use that in the code.

  Most do that anyway and set the account so that it cannot accept incoming e-mail.

JimD.
Avatar of schmir1

ASKER

>Totally forgot about the mswinsck.ocx.  I've primarly use it under XP, but I've got a couple of clients with Win 7 >stations and I don't remember any issues.

I did a successful e-mail test on my XP PC.  Then I tried it on Win7 and got a mswinsck.ocx missing error.  I'm almost there so hopefully I can add mswinsck.ocx to Win7.  Do you know how?  

<<I'm almost there so hopefully I can add mswinsck.ocx to Win7.  Do you know how?  >>

  Sorry no, *but* I just picked up the attached VBA code from Dan Waters on the AccessD developers list as we had been having a discussion there as well on this.

  It's commented that it works under Win 7 and being from VBA, should do the job for you.  It may need some tweaking (i.e. tblParameters) to work.  I intend to use this as soon as I can because I can dump some stuff I'm doing in my install files.

  Also, as a side note, I've been exploring the whole e-mail/Access thing and have just found out that BLAT now has a DLL that is up to date with the .EXE.  It's also a native DLL, which means that it doesn't need to be registered, but simply in the execution path.  I'm going to check that out when I have a chance.

They come bundled in the same 148KB zip file and are available at http://www.blat.net/ 

JimD.
Option Compare Database
Option Explicit

Private Declare Function Register_vbSendMail Lib "vbSendMail.dll" Alias
"DllRegisterServer" () As Long
Private Declare Function Register_mswinsck Lib "mswinsck.ocx" Alias
"DllRegisterServer" () As Long
Private Declare Function UnRegister_vbSendMail Lib "vbSendMail.dll" Alias
"DllUnregisterServer" () As Long
Private Declare Function UnRegister_mswinsck Lib "mswinsck.ocx" Alias
"DllUnregisterServer" () As Long

Public Function RegisterSMTPFiles()
1     On Error GoTo EH

          '-- The two files vbSendMail.dll and mswinsck.ocx are used to
provide support for SMTP Email. _
              The reference to vbSendMail.dll must already exist in the FE
files(s). _
              So, if the files don't exist, they will be copied, and then
will be registered, and the references will work.
          
          '-- This actual file registration occurs on each opening I don't
know how to detect if a file _
              is registered or not.  However, registering on each opening
shouldn't hurt.  If the two files already exist, _
              then the two files will be re-registered.

          Dim retCode As Long
          Dim stgPrompt As String
          Dim fso As FileSystemObject
          Dim stgmsWinSckPath As String
          Dim stgvbSendMailPath As String
          Dim stgSMTPFilesSourcePath As String
          Dim rst As DAO.Recordset
          Dim stg As String
          Dim stgFolderName As String
          
2         stg = "SELECT ServerSystemFolder FROM tblParameters"
3         Set rst = DBEngine(0)(0).OpenRecordset(stg, dbOpenSnapshot)
4         stgSMTPFilesSourcePath = rst("ServerSystemFolder") & "\SMTPFiles"
5         rst.Close
6         Set rst = Nothing
          
7         Set fso = CreateObject("Scripting.FileSystemObject")
          
          '-- Windows 7 w/o System32 folder
8         If fso.FolderExists("C:\Windows\SysWOW64") Then
9             stgmsWinSckPath = "C:\Windows\SysWOW64\mswinsck.ocx"
10            stgvbSendMailPath = "C:\Windows\SysWOW64\vbSendMail.dll"
11            stgFolderName = "C:\Windows\SysWOW64"
12        End If
          
          '-- Windows XP and Windows 7 with System32 folder
13        If fso.FolderExists("C:\Windows\System32") Then
14            stgmsWinSckPath = "C:\Windows\System32\mswinsck.ocx"
15            stgvbSendMailPath = "C:\Windows\System32\vbSendMail.dll"
16            stgFolderName = "C:\Windows\System32"
17        End If
          
          '-- Windows Previous to XP
18        If fso.FolderExists("C:\WINNT\System32") Then
19            stgmsWinSckPath = "C:\WINNT\System32\mswinsck.ocx"
20            stgvbSendMailPath = "C:\WINNT\System32\vbSendMail.dll"
21            stgFolderName = "C:\WINNT\System32"
22        End If
          
          '-- Copy files if needed
23        If fso.FileExists(stgmsWinSckPath) = False Then
24            fso.CopyFile stgSMTPFilesSourcePath & "\mswinsck.ocx",
stgmsWinSckPath
25        End If
26        If fso.FileExists(stgvbSendMailPath) = False Then
27            fso.CopyFile stgSMTPFilesSourcePath & "\vbSendMail.dll",
stgvbSendMailPath
28        End If
          
29        Set fso = Nothing
          
30        retCode = Register_vbSendMail()
      '    MsgBox "vbSendMail.dll Registered"
31        retCode = Register_mswinsck()
      '    MsgBox "mswinsck.dll Registered"
          
32        Exit Function
          
EH:
33        stgPrompt = "vbSendMail registration could not be completed." _
              & vbNewLine & vbNewLine _
              & "The files 'mswinsck.ocx' and/or 'vbSendMail.dll' appear to
be missing from the " & stgFolderName & " folder." _
              & vbNewLine & vbNewLine _
              & "Contact your System Owner.  This application will now Quit.
(Line " & Erl & ")"
34        MsgBox stgPrompt, vbCritical + vbOKOnly, "Missing Reference"
35        DoCmd.Quit

End Function

Open in new window

Avatar of schmir1

ASKER

I can't seem to get mswinsck.ocx registered no matter what I do.

I guess I'll try BLAT.  Too bad.  I thought I was pretty close.
<<I can't seem to get mswinsck.ocx registered no matter what I do.>>

 What happens?  The code I posted indicates that it should be possible.  Haven't tried it myself, but the fellow I got it from said he had been using it for a few years at least.

JimD.
Avatar of schmir1

ASKER

I'm just trying to manual install mswinsck.ocx  for now to see if I can get that to work.  I'm thinking there some other files to this that I don't know about.  Do you know?

I did look at the code.  I don't see how the following are coded?


'Private Declare Function Register_vbSendMail Lib "vbSendMail.dll" Alias "DllRegisterServer" () As Long
'Private Declare Function Register_mswinsck Lib "mswinsck.ocx" Alias "DllRegisterServer" () As Long
'Private Declare Function UnRegister_vbSendMail Lib "vbSendMail.dll" Alias "DllUnregisterServer" () As Long
'Private Declare Function UnRegister_mswinsck Lib "mswinsck.ocx" Alias "DllUnregisterServer" () As Long

Open in new window

Those declares go in the delcarations section of a module at the top outside of any procedures.

They are calling a function as part of the WindowsAPI/COM process that tells a COM object to register or unregister itself.

http://msdn.microsoft.com/en-us/library/ms682162(v=vs.85).aspx

JimD.
Avatar of schmir1

ASKER

VBSendMail works great now on Win7.  I just had to get mswinsck.ocs registered correctly.  Thanks for all you help.  You provided me with a lot of good input.  

Excellent answer!!!

 Glad to hear you got it working :)

JimD.