SendObject method fails in Access 2000 (260819)

WORKAROUND

• Reduce the message length.
  
  Note This resolution works only for the first condition that is described in the "Cause" section. The remaining resolutions work for either condition that is described in the "Cause" section.
• When you only have to send a message without attaching Access objects, send the message by automating the Outlook object library or the Collaborative Data Objects (CDO) object library.
  
  Note If you installed Microsoft Outlook in the Internet Mail Only (IMO) mode, you cannot use CDO and MAPI. For additional information, click the following article number to view the article in the Microsoft Knowledge Base:

  252720 MAPI and CDO are not supported in Outlook IMO mode

  For additional information about sending a message by using the Microsoft Outlook object library, click the following article number to view the article in the Microsoft Knowledge Base:

  161088 Using automation to send a Microsoft Outlook message

• When you have to attach Access objects to a message, use the following sample Microsoft Visual Basic for Applications (VBA) procedure to work around this problem.
  
  Step-by-step example
  
  Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements. The following code may not work correctly if you installed the Outlook e-mail security update. For additional information about this update for Outlook 2000, click the following article number to view the article in the Microsoft Knowledge Base:

  262631 Information about the Outlook e-mail security update

  For additional information about this update for Outlook 98, click the following article number to view the article in the Microsoft Knowledge Base:

  262617 Information about the Outlook e-mail security update

  1. Start Access 2000.
  2. Open the sample database Northwind.mdb.
  3. On the Insert menu, click Class Module.
     
     A new, blank class module opens in the Visual Basic environment.
  4. On the Tools menu, click References.
  5. In the References dialog box, click to select the Microsoft CDO 1.21 Library check box. If this object library is not listed in the References dialog box, click Browse, and then search for the Cdo.dll file.
     
     On a computer that is running Microsoft Windows 95 or Microsoft Windows 98, this file is typically found in the C:\Program Files\Common Files\System\Mapi\1033\95 folder.
     
     On a computer that is running Microsoft Windows NT or Microsoft Windows 2000, this file is typically found in the C:\Program Files\Common Files\System\Mapi\1033\NT folder.
     
     If you do not find the Cdo.dll file on your computer, restart the Office 2000 Setup program, click Add/Remove Features, and then set the Collaboration Data Objects to Run from My Computer under Microsoft Outlook for Windows.
  6. Click OK to close the References dialog box.
  7. Add the following code to the class module:

     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 ERROR_BADDB = 1
     Private Const ERROR_BADKEY = 2
     Private Const ERROR_CANTOPEN = 3
     Private Const ERROR_CANTREAD = 4
     Private Const ERROR_CANTWRITE = 5
     Private Const ERROR_OUTOFMEMORY = 6
     Private Const ERROR_INVALID_PARAMETER = 7
     Private Const ERROR_ACCESS_DENIED = 8
     Private Const ERROR_INVALID_PARAMETERS = 87
     Private Const ERROR_NO_MORE_ITEMS = 259
     Private Const KEY_ALL_ACCESS = &H3F
     Private Const REG_OPTION_NON_VOLATILE = 0
     
     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
     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)
         
         
         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
             If IsMissing(ObjectName) Or IsMissing(OutputFormat) Then
                 MsgBox "The object type, name, or output format is not valid. Cannot send message.", vbCritical
                 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
                     MsgBox "The object type, name, or output format is not valid. Cannot send message.", vbCritical
                     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 ParseAddress(RecipientType As MAPI.CdoRecipientType)
         Dim i As Variant
         For Each i In reciparray
             Set MAPIRecipient = MAPIMessage.Recipients.Add
             With MAPIRecipient
                 .Name = i
                 .Type = RecipientType
                 .Resolve
             End With
             Set MAPIRecipient = Nothing
         Next
     End Sub
     
     Private Function GetExtension(ObjectType As Long) As String
         Select Case ObjectType
             Case 1 'RTF
                 GetExtension = ".RTF"
             Case 2 'TXT
                 GetExtension = ".TXT"
             Case 3 'SNP
                 GetExtension = ".SNP"
             Case 4 'XLS
                 GetExtension = ".XLS"
         End Select
     End Function
     
     Private Function GetOutputFormat(ObjectType As Long)
         Select Case ObjectType
             Case 1 'RTF
                 GetOutputFormat = Access.acFormatRTF
             Case 2 'TXT
                 GetOutputFormat = Access.acFormatTXT
             Case 3 'SNP
                 GetOutputFormat = Access.acFormatSNP
             Case 4 'XLS
                 GetOutputFormat = Access.acFormatXLS
         End Select
     End Function
     
     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
                     MsgBox "Unidentified Operating System.  " & _
                        "Cannot log on to messaging."
                     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
               MsgBox "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
         End Select
     End Sub
     
     Private Function QueryValue _
         (sKeyName As String, _
         sValueName As String)
         
         Dim lRetVal As Long     'Result of the API functions.
         Dim hKey As Long        'Handle of the opened key.
         Dim vValue As Variant   'Setting of the queried value.
         
         lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, _
                     sKeyName, _
                     0, _
                     KEY_ALL_ACCESS, _
                     hKey)
         
         lRetVal = QueryValueEx(hKey, _
                     sValueName, _
                     vValue)
         QueryValue = vValue
         RegCloseKey (hKey)
         
     End Function
     
     Private Function QueryValueEx _
            (ByVal lhKey As Long, _
            ByVal szValueName As String, _
            vValue As Variant) As Long
         
         Dim cch As Long
         Dim lrc As Long
         Dim lType As Long
         Dim lValue As Long
         Dim sValue As String
         
         On Error GoTo QueryValueExError
         
         ' Determine the size and the type of the data to be read.
         lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
         If lrc <> ERROR_NONE Then Error 5
         
         Select Case lType
            ' For strings
            Case REG_SZ:
               sValue = String(cch, 0)
               lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
                  sValue, cch)
               If lrc = ERROR_NONE Then
                  vValue = Left$(sValue, cch)
               Else
                  vValue = Empty
               End If
            ' For DWORDS
            Case REG_DWORD:
               lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
                  lValue, cch)
               If lrc = ERROR_NONE Then vValue = lValue
            Case Else
               'All other data types that are not supported.
               lrc = -1
         End Select
         
     QueryValueExExit:
         QueryValueEx = lrc
         Exit Function
     QueryValueExError:
         Resume QueryValueExExit
         End Function
      
     								

  8. On the View menu, click Properties Window.
  9. Set the Name property to accSendObject.
  10. On the Insert menu, click Module.
      
      This adds a new, standard module to your VBA project.
  11. Add the following code to the module:

          Sub SendMail()
             Dim clsSendObject As accSendObject
             Dim strMsg As String      
      
             Set clsSendObject = New accSendObject
             strMsg = String(3000, "a")
             clsSendObject.SendObject acSendReport, "Alphabetical list of products", accOutputSNP, _
               "<SomeEmailName>", , , "This is a test subject", strMsg, True
             Set clsSendObject = Nothing
          End Sub
       
      								

      In the code, replace <SomeEmailName> with a valid e-mail address.
  12. On the Debug menu, click Compile Project Name.
  13. On the File menu, click Save Project Name.
  14. To test this procedure, type the following line in the Immediate window, and then press ENTER:

      SendMail
      								

      The code sends an e-mail message with the "Alphabetical list of products" report attached as a snapshot file.
  Usage and Limitations
  
  This sample code is designed to function as closely as possible to the DoCmd.SendObject method in Access. The syntax for calling the DoCmd.SendObject method is similar to calling the SendObject method in Access. The DoCmd.SendObject method has a limitation. The DoCmd.SendObject method is designed to output objects only in text format (.txt), rich text format (.rtf), Excel format (.xls), or snapshot format (.snp). If you try to output objects in other formats, you receive an error.
  
  Note This code has only been tested by using Microsoft Outlook as the MAPI client. The code may not work with other MAPI-enabled mail applications. We do not support the use of this sample code with third-party MAPI applications.