Send email with outlook express 'editing mode'

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • zivon
    New Member
    • Aug 2007
    • 59

    Send email with outlook express 'editing mode'

    now for the bigger problam :)

    I know you pepole hate using OE for sending emails, but its user friendly and its needed in this case...

    I found on this forum, a code that sends email using OE with attachments.

    it works, but with two problams... first, its directly sends the email, without opening the OE "editing mode" of the email, like when you use the DoCmd.SendObjec t.
    this is the smaller problams though...

    the bigger problam which I think is connected to the first one, is that when it send the email it also neutralize access completely untill the email is sent. and if I attach a big file (which will be always in my db case...) you can't continue working on the db... : \

    maybe I need a completly diffrent code, but I'll paste what I'm trying anyway, maybe it will help someone else :)

    on a module:

    Code:
    Option Compare Database
    Option Explicit
    
    
    Private Type MAPIRecip
    Reserved As Long
    RecipClass As Long
    Name As String
    Address As String
    EIDSize As Long
    EntryID As String
    End Type
    
    Private Type MAPIFileTag
    Reserved As Long
    TagLength As Long
    Tag() As Byte
    EncodingLength As Long
    Encoding() As Byte
    End Type
    
    Private Type MAPIFile
    Reserved As Long
    Flags As Long
    Position As Long
    PathName As String
    FileName As String
    FileType As Long
    End Type
    
    Private Type MAPIMessage
    Reserved As Long
    Subject As String
    NoteText As String
    MessageType As String
    DateReceived As String
    ConversationID As String
    Originator As Long
    Flags As Long
    RecipCount As Long
    Recipients As Long
    FileCount As Long
    Files As Long
    End Type
    
    Private Declare Function MAPISendMail Lib "c:\program files\outlook express\msoe.dll" (ByVal Session As Long, ByVal UIParam As Long, ByRef message As MAPIMessage, ByVal Flags As Long, ByVal Reserved As Long) As Long
    Private Const MAPI_E_NO_LIBRARY = 999
    Private Const MAPI_E_INVALID_PARAMETER = 998
    
    Private Const MAPI_ORIG = 0
    Private Const MAPI_TO = 1
    Private Const MAPI_CC = 2
    Private Const MAPI_BCC = 3
    
    Private Const MAPI_UNREAD = 1
    Private Const MAPI_RECEIPT_REQUESTED = 2
    Private Const MAPI_SENT = 4
    
    Private Const MAPI_LOGON_UI = &H1
    Private Const MAPI_NEW_SESSION = &H2
    Private Const MAPI_DIALOG = &H8
    Private Const MAPI_UNREAD_ONLY = &H20
    Private Const MAPI_ENVELOPE_ONLY = &H40
    Private Const MAPI_PEEK = &H80
    Private Const MAPI_GUARANTEE_FIFO = &H100
    Private Const MAPI_BODY_AS_FILE = &H200
    Private Const MAPI_AB_NOMODIFY = &H400
    Private Const MAPI_SUPPRESS_ATTAch = &H800
    Private Const MAPI_FORCE_DOWNLOAD = &H1000
    
    Private Const MAPI_OLE = &H1
    Private Const MAPI_OLE_STATIC = &H2
    
    
    Dim mAf() As MAPIFile
    Dim mAr() As MAPIRecip
    Dim lAr As Long
    Dim lAf As Long
    Dim mM As MAPIMessage
    Dim aErrors(0 To 26) As String
    
    Public Sub Class_Initialize()
    aErrors(0) = "Success"
    aErrors(1) = "User Abort"
    aErrors(2) = "Failure"
    aErrors(3) = "LogIn Failure"
    aErrors(4) = "Disk Full"
    aErrors(5) = "Insufficient Memory"
    aErrors(6) = "Block Too Small"
    aErrors(8) = "Too Many Sessions"
    aErrors(9) = "Too Many Files"
    aErrors(10) = "Too Many Recipients"
    aErrors(11) = "Attachment No Found"
    aErrors(12) = "Attachment Open Failure"
    aErrors(13) = "Attachment Write Failure"
    aErrors(14) = "Unknown Recipient"
    aErrors(15) = "Bad Recipient"
    aErrors(16) = "No Messages"
    aErrors(17) = "Invalid Message"
    aErrors(18) = "Text Too Large"
    aErrors(19) = "Invalid Session"
    aErrors(20) = "Type Not Suppported"
    aErrors(21) = "Ambiguous Recipient"
    aErrors(22) = "Message in Use"
    aErrors(23) = "Network Failure"
    aErrors(24) = "Invalid Edit Fields"
    aErrors(25) = "Invalid Recipient"
    aErrors(26) = "Not Supported"
    End Sub
    
    Public Sub BCCAddressAdd(ByVal strAddress As String)
        RecipientAdd MAPI_BCC, , strAddress
    End Sub
    
    Public Sub BCCNameAdd(ByVal strName As String)
        RecipientAdd MAPI_BCC, strName
    End Sub
    
    Public Sub CCAddressAdd(ByVal strAddress As String)
        RecipientAdd MAPI_CC, , strAddress
    End Sub
    
    Public Sub CCNameAdd(ByVal strName As String)
        RecipientAdd MAPI_CC, strName
    End Sub
    
    Public Sub MessageIs(ByVal strNoteText As String)
        mM.NoteText = strNoteText
    End Sub
    
    Public Sub SubjectIs(ByVal strSubject As String)
        mM.Subject = strSubject
    End Sub
    
    Public Sub ToAddressAdd(ByVal strAddress As String)
        RecipientAdd MAPI_TO, , strAddress
    End Sub
    
    Public Sub ToNameAdd(ByVal strName As String)
        RecipientAdd MAPI_TO, strName
    End Sub
    
    Public Sub FileAdd(ByVal strPathName As String)
        Dim f As MAPIFile
    With f
        .PathName = StrConv(strPathName, vbFromUnicode)
    End With
    ReDim Preserve mAf(lAf)
    mAf(lAf) = f
    lAf = lAf + 1
    End Sub
    
    Public Sub Send()
    Dim r As Long
    With mM
        If lAf > 0 Then
            .FileCount = lAf
            .Files = VarPtr(mAf(0))
        End If
        If lAr > 0 Then
            .RecipCount = lAr
            .Recipients = VarPtr(mAr(0))
            r = MAPISendMail(0, 0, mM, 0, 0)
            If r <> 0 Then MsgBox aErrors(r)
        End If
    End With
    End Sub
    
    Private Sub RecipientAdd(ByVal lngType As Long, Optional ByVal strName As String, Optional ByVal strAddress As String)
    Dim r As MAPIRecip
    r.RecipClass = lngType
    If strName <> "" Then r.Name = StrConv(strName, vbFromUnicode)
    If strAddress <> "" Then r.Address = StrConv(strAddress, vbFromUnicode)
    ReDim Preserve mAr(lAr)
    mAr(lAr) = r
    lAr = lAr + 1
    End Sub
  • ADezii
    Recognized Expert Expert
    • Apr 2006
    • 8834

    #2
    Originally posted by zivon
    now for the bigger problam :)

    I know you pepole hate using OE for sending emails, but its user friendly and its needed in this case...

    I found on this forum, a code that sends email using OE with attachments.

    it works, but with two problams... first, its directly sends the email, without opening the OE "editing mode" of the email, like when you use the DoCmd.SendObjec t.
    this is the smaller problams though...

    the bigger problam which I think is connected to the first one, is that when it send the email it also neutralize access completely untill the email is sent. and if I attach a big file (which will be always in my db case...) you can't continue working on the db... : \

    maybe I need a completly diffrent code, but I'll paste what I'm trying anyway, maybe it will help someone else :)

    on a module:

    Code:
    Option Compare Database
    Option Explicit
    
    
    Private Type MAPIRecip
    Reserved As Long
    RecipClass As Long
    Name As String
    Address As String
    EIDSize As Long
    EntryID As String
    End Type
    
    Private Type MAPIFileTag
    Reserved As Long
    TagLength As Long
    Tag() As Byte
    EncodingLength As Long
    Encoding() As Byte
    End Type
    
    Private Type MAPIFile
    Reserved As Long
    Flags As Long
    Position As Long
    PathName As String
    FileName As String
    FileType As Long
    End Type
    
    Private Type MAPIMessage
    Reserved As Long
    Subject As String
    NoteText As String
    MessageType As String
    DateReceived As String
    ConversationID As String
    Originator As Long
    Flags As Long
    RecipCount As Long
    Recipients As Long
    FileCount As Long
    Files As Long
    End Type
    
    Private Declare Function MAPISendMail Lib "c:\program files\outlook express\msoe.dll" (ByVal Session As Long, ByVal UIParam As Long, ByRef message As MAPIMessage, ByVal Flags As Long, ByVal Reserved As Long) As Long
    Private Const MAPI_E_NO_LIBRARY = 999
    Private Const MAPI_E_INVALID_PARAMETER = 998
    
    Private Const MAPI_ORIG = 0
    Private Const MAPI_TO = 1
    Private Const MAPI_CC = 2
    Private Const MAPI_BCC = 3
    
    Private Const MAPI_UNREAD = 1
    Private Const MAPI_RECEIPT_REQUESTED = 2
    Private Const MAPI_SENT = 4
    
    Private Const MAPI_LOGON_UI = &H1
    Private Const MAPI_NEW_SESSION = &H2
    Private Const MAPI_DIALOG = &H8
    Private Const MAPI_UNREAD_ONLY = &H20
    Private Const MAPI_ENVELOPE_ONLY = &H40
    Private Const MAPI_PEEK = &H80
    Private Const MAPI_GUARANTEE_FIFO = &H100
    Private Const MAPI_BODY_AS_FILE = &H200
    Private Const MAPI_AB_NOMODIFY = &H400
    Private Const MAPI_SUPPRESS_ATTAch = &H800
    Private Const MAPI_FORCE_DOWNLOAD = &H1000
    
    Private Const MAPI_OLE = &H1
    Private Const MAPI_OLE_STATIC = &H2
    
    
    Dim mAf() As MAPIFile
    Dim mAr() As MAPIRecip
    Dim lAr As Long
    Dim lAf As Long
    Dim mM As MAPIMessage
    Dim aErrors(0 To 26) As String
    
    Public Sub Class_Initialize()
    aErrors(0) = "Success"
    aErrors(1) = "User Abort"
    aErrors(2) = "Failure"
    aErrors(3) = "LogIn Failure"
    aErrors(4) = "Disk Full"
    aErrors(5) = "Insufficient Memory"
    aErrors(6) = "Block Too Small"
    aErrors(8) = "Too Many Sessions"
    aErrors(9) = "Too Many Files"
    aErrors(10) = "Too Many Recipients"
    aErrors(11) = "Attachment No Found"
    aErrors(12) = "Attachment Open Failure"
    aErrors(13) = "Attachment Write Failure"
    aErrors(14) = "Unknown Recipient"
    aErrors(15) = "Bad Recipient"
    aErrors(16) = "No Messages"
    aErrors(17) = "Invalid Message"
    aErrors(18) = "Text Too Large"
    aErrors(19) = "Invalid Session"
    aErrors(20) = "Type Not Suppported"
    aErrors(21) = "Ambiguous Recipient"
    aErrors(22) = "Message in Use"
    aErrors(23) = "Network Failure"
    aErrors(24) = "Invalid Edit Fields"
    aErrors(25) = "Invalid Recipient"
    aErrors(26) = "Not Supported"
    End Sub
    
    Public Sub BCCAddressAdd(ByVal strAddress As String)
        RecipientAdd MAPI_BCC, , strAddress
    End Sub
    
    Public Sub BCCNameAdd(ByVal strName As String)
        RecipientAdd MAPI_BCC, strName
    End Sub
    
    Public Sub CCAddressAdd(ByVal strAddress As String)
        RecipientAdd MAPI_CC, , strAddress
    End Sub
    
    Public Sub CCNameAdd(ByVal strName As String)
        RecipientAdd MAPI_CC, strName
    End Sub
    
    Public Sub MessageIs(ByVal strNoteText As String)
        mM.NoteText = strNoteText
    End Sub
    
    Public Sub SubjectIs(ByVal strSubject As String)
        mM.Subject = strSubject
    End Sub
    
    Public Sub ToAddressAdd(ByVal strAddress As String)
        RecipientAdd MAPI_TO, , strAddress
    End Sub
    
    Public Sub ToNameAdd(ByVal strName As String)
        RecipientAdd MAPI_TO, strName
    End Sub
    
    Public Sub FileAdd(ByVal strPathName As String)
        Dim f As MAPIFile
    With f
        .PathName = StrConv(strPathName, vbFromUnicode)
    End With
    ReDim Preserve mAf(lAf)
    mAf(lAf) = f
    lAf = lAf + 1
    End Sub
    
    Public Sub Send()
    Dim r As Long
    With mM
        If lAf > 0 Then
            .FileCount = lAf
            .Files = VarPtr(mAf(0))
        End If
        If lAr > 0 Then
            .RecipCount = lAr
            .Recipients = VarPtr(mAr(0))
            r = MAPISendMail(0, 0, mM, 0, 0)
            If r <> 0 Then MsgBox aErrors(r)
        End If
    End With
    End Sub
    
    Private Sub RecipientAdd(ByVal lngType As Long, Optional ByVal strName As String, Optional ByVal strAddress As String)
    Dim r As MAPIRecip
    r.RecipClass = lngType
    If strName <> "" Then r.Name = StrConv(strName, vbFromUnicode)
    If strAddress <> "" Then r.Address = StrConv(strAddress, vbFromUnicode)
    ReDim Preserve mAr(lAr)
    mAr(lAr) = r
    lAr = lAr + 1
    End Sub
    It could be the nature of the code that it is executed synchronously, meaning all other processes are suspended until current code completion.

    Comment

    Working...