Dear All

I am building 2 applications (1 Access, 1 Excel) which use MAPI functionality to send emails.

Everything works fine and the VBA routine loops through my recordsets, creates emails, attaches files and sends the emails off. brilliant.

One problem - I demonstrated the apps to the customer today and everything is fine except that when people open the emails, she wants them to appear as if they have been sent from a different mailbox. I.e. she is logged on to her account (say, Rachel Green), she also has full permissions for another mailbox called CST Customer Reports. She send emails from this mailbox by using the FROM field in Outlook. Can I do this through the MAPI VBA? I can't find any settings that will allow me to set this property.

Any help greatly appreciated

This is a sample of code that I am using to send pages to email addresses. I have a sheet that contains an address list and another sheet that has a form that I feel out before sending the email. It uses API to pull up the "from" address. Hope it helps!

************************************************** ***************
Dim reclist As String


Private Sub ComboBox1_Change()

End Sub

Private Sub CommandButton1_Click()

Call Page

End Sub


Private Sub Page()

'************************reset recipient list*********************

reclist = ""
If InStr(UCase(ComboBox1.Text), "ALL") Then
     For X = 4 To 82
     reclist = reclist & Worksheets("Contact Info").Range("G" & X).Value & ";"
     Next X
End If
If InStr(ComboBox1.Text, "This is the First list") Then
     For X = 84 To 95
     reclist = reclist & Worksheets("Contact Info").Range("G" & X).Value & ";"
     Next X
End If
If InStr(ComboBox1.Text, "This is the Second list") Then
     For X = 97 To 125
     reclist = reclist & Worksheets("Contact Info").Range("G" & X).Value & ";"
     Next X
End If
If InStr(ComboBox1.Text, "This is the Third list") Then
     For X = 127 To 152
     reclist = reclist & Worksheets("Contact Info").Range("G" & X).Value & ";"
     Next X
End If
Call sendcall(reclist)
End Sub

Public Function SendAPI()
Dim Finder, FindRTCRL, FindRTCRL2 As Long
Finder = FindWindow("rctrl_renwnd32", vbNullString)
    FindRTCRL = FindWindowEx(Finder, 0, "AfxWnd", vbNullString)
    FindRTCRL1 = FindWindowEx(FindRTCRL, 0, "#32770", vbNullString)
    FindRTCRL2 = FindWindowEx(FindRTCRL1, 0, "RichEdit20A", vbNullString)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_T, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_H, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_E, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_I, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_R, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_SPACE, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_E, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_M, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_A, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_I, 0)
    Call PostMessage(FindRTCRL2&, WM_KEYDOWN, VK_L, 0)
End Function




Private Sub sendcall(reclist As String)

     Dim OutL As Outlook.Application
     Dim thisMailItem As Outlook.MailItem
     Dim rMailItem As Outlook.MailItem
         Dim Finder As Long
     Dim OutlookWasOpen As Boolean

     On Error Resume Next
         Set OutL = GetObject(, "Outlook.Application")
         If OutL Is Nothing Then
             OutlookWasOpen = False
             Set OutL = CreateObject("Outlook.Application")
         Else
             OutlookWasOpen = True
         End If
     On Error GoTo 0

     If OutL Is Nothing Then
         MsgBox "Unable to open the Microsoft Outlook Application." & _
                         "The Email cannot be created or sent"
              End If

     Set thisMailItem = OutL.CreateItem(olMailItem)

     thisMailItem.BCC = Trim(reclist)
     thisMailItem.Subject = "Your Sbuject"
     thisMailItem.Body = TextBox1.Text
    thisMailItem.Display


SendAPI


     Set thisMailItem = Nothing
     If OutlookWasOpen Then
         Set OutL = Nothing
     Else

         Set OutL = Nothing
     End If
End Sub

Private Sub Worksheet_Activate()

If ComboBox1.ListCount = 0 Then
ComboBox1.AddItem "ALL"
ComboBox1.AddItem "This is the First list"
ComboBox1.AddItem "This is the Second list"
ComboBox1.AddItem "This is the Third list"

Else
End If

End Sub