Request for help with Outlook email

Turns out I do have Outlook (2003) installed on my system (XP/Pro) , I just never set it up. (MS Office entry level: Outlook, Word, Excel; no PowerPoint, no MS-Access)

So I set it up and now I, too can get the "Object Model Guard Page" warnings. So that should make it easier to find a good solution here... before I start twinking around with client systems with every conceivable combination of O/S and Outlook.

FWIW, this is actually two separate applications
1. Generate a file and present an Outlook "new mail item" to the user with the file attached, a "To" and a "CCTo" , some default subject and message text, and allow the user to edit the message, attach additional files, add/delete some "To" and "CC" address and then send it.

2. Unattended "create and send a mail." THis program already has a configurable "EMAILTYPE=MAPI" option and that works great; I'm just adding an "EMAILTYPE=OUTLOOK" INI file option. (since Outlook don't do MAPI and it IS ubiquitous in my primary market)

As of now both work correctly; the only hangup is the security prompt (Outlook type only) . Once you click "OK" in response to that everything is just hunky-dory.

MCM

I am looking for assistance with either this application or perhaps with Outlook Settings.

I have reduced the application to this "compile and run" PB/CC or PB/WIn sample....

My problem is this:

When running on NT4/Outlook 98, the program runs as designed with no interruptions

When running on Windows/XP with Outlook 2003, Adding recipients results in an interruption from
"somewhere" which prompts:

"A program is trying to access email addresses stored in Outlook. Do you wish to allow this?

You get a little drop-down list to allow access for 1, 2, 5 or 10 minutes.

In its finished form this program is SUPPOSED to just "do it"... either EMAIL_DISP_SEND (send it), or EMAIL_DISP_SHOW (put up the Outlook user's "new mail item" screen for edit and manual 'send.')... WITHOUT requiring any operator intervention.

So the question is, "How can I avoid the operator intervention?

Do I need to "Logon" to outlook (logon method of namespace object)?

Is there a setting a user can make to "allow this without prompt?"

The code of the program is posted below.

The #INCLUDE file for the interfaces is a little too long, so that is ZIPped up and attached.

The Outlook Object model documentation is at http://msdn.microsoft.com/en-us/library/bb177050.aspx

Thanks in advance.
MCM

DEMO PROGRAM

Code:

'testolem.bas
' Stipped down tester of Outlook email to run tests.

#COMPILE EXE
#DIM ALL

#INCLUDE "WIN32API.INC"


#IF %DEF(%PB_WIN32)
 FUNCTION STDOUT (Z AS STRING) AS LONG
 ' returns TRUE (non-zero) on success

   LOCAL hStdOut AS LONG, nCharsWritten AS LONG
   LOCAL nStdHandle   AS DWORD   ' casting problems>
   LOCAL w AS STRING
   STATIC CSInitialized AS LONG, CS AS CRITICAL_SECTION
   LOCAL iRET AS LONG, LE AS LONG
   LOCAL hWndConsole   AS LONG
   ' ------------------------

   IF ISFALSE CSInitialized THEN
       InitializeCriticalSection CS
       CSInitialized  =  1
       ' soething else to do only once per process:
       ' cant use this with Nt 4.0
      ' hWndConsole       = GetConsoleWindow ()
      ' IF ISFALSE hWndConsole THEN
      '    ALLOCConsole
      ' END IF

       nStdHandle = BITS???(%STD_OUTPUT_HANDLE)   'STD_OUTPUT_HANDLE defined in Win32API.INC as -11&
       hStdOut         = GetStdHandle (nStdHandle)  ' per Win32API.INC wants DWORD param, returns DWORD
       IF (hSTdOut = %NULL)  OR  (BITS???(hStdOut) = BITS??? (%INVALID_HANDLE_VALUE) ) THEN
            AllocConsole
       END IF


   END IF

   nStdHandle = BITS???(%STD_OUTPUT_HANDLE)   'STD_OUTPUT_HANDLE defined in Win32API.INC as -11&

   EntercriticalSection Cs

   hStdOut         = GetStdHandle (nStdHandle)  ' per Win32API.INC wants DWORD param, returns DWORD

   SELECT CASE AS LONG hStdOut
       CASE %NULL, -1&
           iRet = AllocConsole        ' OK, it creates the first time
           LE   = GetLAstError
           #IF 0
           IF ISFALSE iRet THEN
               MSGBOX "Could not create Console" & $CRLF & SystemErrorMessageText (LE)
           ELSE
               MSGBOX "Created Console"
           END IF
           #ENDIF

           hStdOut       = GetStdHandle (%STD_OUTPUT_HANDLE)

   END SELECT

   LeaveCriticalSection    CS

   w                     = Z & $CRLF
   iRet                  = WriteFile(hStdOut, BYVAL STRPTR(W), LEN(W),  nCharsWritten, BYVAL %NULL)
   LE                    = GETLastError
   FUNCTION              = iRet
   #IF 0
   IF ISFALSE iREt THEN
       MSGBOX SystemErrorMessageTExt(LE),,"WriteFile Failed"
       ' 2/18/08 its failing on invalid handle. but I am getting a value of 7 which should be valid
       ' I am NOT creating it... I am inheriting it. What If I create my own instead?
       ' See 'fix' above using GetConsoleWindow. This code is not going to work
       ' on Win/98 anymore.
   END IF
   #ENDIF

   FUNCTION = iRet   ' true is good


 END FUNCTION

#ENDIF


FUNCTION PBMAIN () AS LONG

     LOCAL sfrom, sTo, sCC, sSubject, sBody, sAttachString AS  STRING
     LOCAL iDisp AS LONG
     LOCAL szErrMSg AS ASCIIZ * 1024
     LOCAL iRet AS LONG



     sFrom = ""    ' not used with Outlook/Exchange Server
     sTo   = "[email protected]"
     sCC   = "[email protected]"
     sSubject = USING$("Outlook Email Testing  & &", DATE$, TIME$)

     sAttachString = "D:\Software_Development\projects\tsqemail\Attachment1.txt" _
                   & ";" _
                   & "D:\Software_Development\projects\tsqemail\Attachment2.txt"

'%EMAIL_DISP_SEND    = 1&
'%EMAIL_DISP_DISPLAY = 2&

     iDISP =  1&

     iRet = OutlookSendEmail _
               (BYVAL STRPTR(sFrom), _
               BYVAL STRPTR(sTO), _
              BYVAL IIF& (LEN(sCc), STRPTR (sCC), %NULL), _
             BYVAL STRPTR (sSubject), _
             BYVAL STRPTR (sBody), _
             sAttachString, _
            iDisp, _
            szErrMsg, _
            SIZEOF(szErrMSg))

  STDOUT USING$ ("SendEmail returns # &", iRet, IIF$(iret=0, "success", szErrmsg))
  
  #IF %DEF (%PB_CC32)
       WAITKEY$
  #ELSE
      MSGBOX "End of Demo, check console displays before exiting",,"Testing"
  #ENDIF


END FUNCTION

#INCLUDE "OutlookSendemail.inc"


#IF 0
FUNCTION OutLookSendEmail (szFrom AS ASCIIZ,_
                           sztO AS ASCIIZ, _
                           szCC AS ASCIIZ , _
                           szSubject AS ASCIIZ, _
                           szBody AS ASCIIZ, _
                           sAttachString AS STRING, _
                           BYVAL iDisposition AS LONG, _
                           szErrMsg AS ASCIIZ, _
                           BYVAL cbErrMsg AS LONG) AS LONG
#ENDIF

SEND EMAIL INCLUDE FILE

Code:

'OUTLOOK EMAIL SUPPORT FUNCTION FOR USE IN TSQEMAIL and other programs.
'#INCLUDE "OUTLOOK_OBJECT_LIB.INC"
#INCLUDE "OUTLOOK_8_IDBIND_OBJECT_LIB.INC"   ' created by browser 2.00

 ' iRet = MapiSendEmail (szfrom, szTo, szCC, szAttach, szSubject, szText, SzErrMsg, BYVAL cbERRMsg )


' NOT USED FOR OUTLOOK MAIL: szFrom  (But it can be...
' CONTENT OPTIONAL:  szCC, szAttach,
' OUTLOOK OPTIONAL BUT REQUIRED CONTENT IN TSQEMAIL: szSubject, szBody (edit elsewhere, this function
' will handle transparently)
' To allow for logon in a later version:
'  expression.Logon(Profile, Password, ShowDialog, NewSession)
'  expression   A variable that represents a NameSpace object. (CAN GET HERE NO NEED TO PASS)
' need: disposition (display or send or something else down the road)

'
#IF NOT %DEF(%EMAIL_DISP_SEND)
  %EMAIL_DISP_SEND    = 1&
  %EMAIL_DISP_DISPLAY = 2&
#ENDIF

' returns; FALSE, no FATAL Errors, else text of error message in szErrMsg
' not there are non-fatal errors possible...

#IF %DEF (%PB_CC32)

    MACRO  TDELAY (S) =  STDOUT S: STDOUT "ANY KEY": WAITKEY$
#ELSE
    MACRO  TDELAY (S) =  STDOUT S
#ENDIF


FUNCTION OutLookSendEmail (szFrom AS ASCIIZ,_
                           sztO AS ASCIIZ, _
                           szCC AS ASCIIZ , _
                           szSubject AS ASCIIZ, _
                           szBody AS ASCIIZ, _
                           sAttachString AS STRING, _
                           BYVAL iDisposition AS LONG, _
                           szErrMsg AS ASCIIZ, _
                           BYVAL cbErrMsg AS LONG) AS LONG

  LOCAL oOutLookApp AS Int__DApplication
  LOCAL oNameSpace AS  NameSpace
  LOCAL oMailItem  AS Int__DMailItem

  LOCAL bNewInstance AS LONG, sAttach AS STRING
  LOCAL S AS STRING, W AS STRING, vW  AS VARIANT
  LOCAL vRes  AS VARIANT
  LOCAL iRet  AS LONG, E AS LONG
  LOCAL I, N AS LONG
  LOCAL psz AS ASCIIZ PTR

  LOCAL vSubject, vBody, vTO AS VARIANT, cCC AS VARIANT
  LOCAL vAttachSource, vAttachType, vAttachPosition, vDisplayName AS VARIANT
  LOCAL ipos AS LONG

  LOCAL vSub  AS  VARIANT

  STDOUT "Entered Outlook SendEmail)

  ' objactive only returns info re "COM Objects in EXE form" And I never got anything other than false.
  LET oOutLookApp =  GETCOM CLSID $CLSID_APPLICATION
  IF ISFALSE ISOBJECT (oOutLookApp) THEN
        LET oOutlookApp =  NEWCOM CLSID $CLSID_APPLICATION
        bNewInstance =  %TRUE
  END IF

  ' THIS WORKS BUT I WISH TO OBSERVE THE NEW/GET  behavior with outlook running or not
  ' LET oOutLookApp = ANYCOM CLSID $CLSID_Application

  IF ISFALSE ISOBJECT(oOutLookApp) THEN
       FUNCTION      = %TRUE
       szErrMsg      =  "Unable to open or obtain instance of Outlook"
       EXIT FUNCTION
  END IF
  TDELAY ("Got Outlook Instance")



  ' ----------------------------------------------------
  ' I did not need to do this on the other systems
  ' However, the namespace object is required for some things,
  ' eg Logon.
#IF 0
  w      = "MAPI"
  LET vW =   w AS STRING
  OBJECT CALL      oOutLookApp.GetNameSpace(VW) TO oNameSpace
  iRet = OBJRESULT
  IF iRet <> %S_OK THEN
      DisplayResult USING$("Cannot obtain namespace iret #", iRet)
  ELSE
    DisplayResult "Obtained a namespace"
  END IF
#ENDIF

   'CREATE A NEW MAIL ITEM.
   ' You must create thru the application, CreateObject not supported


   LET vW       = %OlItems_olMailItem
   OBJECT CALL    oOutlookApp.CreateITem (VW) TO  oMailItem
   E           = ERR
   iRet        = OBJRESULT
   IF iRet <> %S_OK THEN
        szErrMsg = LEFT$(USING$ ("Cannot Create new Outlook Mail Item & &", $CRLF, IDISPINFO.DESC$), cbErrMsg-1)
        FUNCTION = %TRUE   ' fatal error
        LET oOutLookApp   = NOTHING
        EXIT FUNCTION
   END IF


   IF ISOBJECT (oMailItem) THEN
        STDOUT "Created New Mail item"
   END IF

   TDELAY ("created New Mail Item")


#IF 0
   ' I get nothing with either of these as strings as documented.
   ' It think perhaps once I create this I can try the display method?
   ' not getting anything here (my system) or at Hilco, or at Cloyes
   OBJECT GET oMailItem.OutlookVersion  TO VW
   ' No errors with valid object
   E    = ERR
   iRet = OBJRESULT
   DisplayResult  USING$("GetOutlookVersion ERR #  OBJRESULT #", E, iRet)
   IF ERR <> 0 THEN
        DisplayResult USING$("ERR #  &", E, ERROR$(E))
   END IF

   IF iRet <> %S_OK THEN
        DisplayResult USING$("Could not get Outlook version from iMailItem ERR # OBRESULT # & ", E, iRet, OBJRESULT$(iret))
   ELSE
        DisplayResult USING$("Got OutlOok version as '&'", VARIANT$(vw))
   END IF
   '
   OBJECT GET oMailItem.OutlookInternalVersion  TO VW
   ' No errors with valid object
   E    = ERR
   iRet = OBJRESULT
   DisplayResult  USING$("Get OutlookInternalVersion ERR #  OBJRESULT #", E, iRet)
   IF ERR <> 0 THEN
        DisplayResult USING$("ERR #  &", E, ERROR$(E))
   END IF

   IF iRet <> %S_OK THEN
        DisplayResult USING$("Could not get Outlook Internal version from iMailItem ERR # OBRESULT # & ", E, iRet, OBJRESULT$(iret))
   ELSE
        DisplayResult USING$("Got OutlOok Internal version as '&'", VARIANT$(vw))
   END IF
#ENDIF

   ' ------------------------------------------------------------------------------------
   '  Set the properties of the things I want to set for the user
   '  This will be to address,subject and some body text, PLUS attachments renamed



   S  =   szSubject             ' dynamic string
   LET  vSubject = S            ' put in param
   OBJECT LET  oMailItem.Subject = vSubject    ' update the mail item


  ' get primary recipients
   S = szTo                     ' dynamic string; multiple may be semicolon delimited
   W = RTRIM$(S, ";")           ' ensure infix format
   n = PARSECOUNT (W, ";")


   FOR I = 1 TO N
        W    = PARSE$(S, ";", I)
        vTo  =  W
        OBJECT CALL oMailitem.Recipients.Add (vTo)
        iRet = OBJRESULT
        IF IRet = %S_OK THEN
        ' set the recipient type
          vSub = I
          vW   = %olmailRecipientType_olTo
          OBJECT LET  oMailItem.Recipients.Item(vSub).TYPE =  vW
          iRet = OBJRESULT
        END IF
        IF iRet <> %S_OK THEN
             TDELAY (USING$ ("Adding recipient # failed &", I, IDISPINFO.DESC$))
             FUNCTION = %TRUE
             EXIT FUNCTION
        END IF

   NEXT
   ' check our count
   OBJECT GET  oMailItem.Recipients.Count TO vW

   STDOUT USING$ ("Found # Primary Recipients_, # added to Mail Item", N, VARIANT#(vW))

   ' -----------------------------
   '  ANY CCS?
   ' ----------------------------
   IF ISTRUE VARPTR(szCC) THEN

       S = szCC                     ' dynamic string; multiple may be semicolon delimited
       W = RTRIM$(S, ";")           ' ensure infix format
       n = PARSECOUNT (W, ";")

       FOR I = 1 TO N
           W = PARSE$(S, ";", I)
           vTo  =  W
           OBJECT CALL oMailitem.Recipients.Add (vTo)
           ' set the recipient type
           vSub = I
           vW   = %olmailRecipientType_olCC
           OBJECT LET  oMailItem.Recipients.Item(vSub).TYPE =  vW
      NEXT
      STDOUT USING$ ("Found # CC Recipients_, now # total recipients of Mail Item", N, VARIANT#(vW))

   END IF  ' if we had any CC recipients

   ' add the body of the message
   S         =  szBody
   LET vBody = S
   OBJECT LET  oMailItem.BOdy =  vBody


   ' ------------------------------------
   ' DO WE HAVE ANY ATTACHMENTS TO ADD?
   ' THese will come in here as semicolon infix-delimited strong
   ' ------------------------------------
   IF LEN(sAttachString ) THEN
        s = sAttachString         ' easier to type here
        N = PARSECOUNT (s, ";")   ' how many?
        FOR I = 1 TO N
             vAttachPosition   =  I
             vAttachType       =   %OlAttachmentType_olByValue
             sAttach           =   PARSE$(s, ";", I)
             vAttachSource    =  sAttach
             w                = PATHSCAN$(NAMEX, sAttach)
             VDisplayName    =  W
             STDOUT USING$ ("Attaching file '&'", sAttach)
             OBJECT CALL oMailItem.Attachments.Add (vAttachSource, vAttachType, vAttachPosition, vDisplayName)
             iRet = OBJRESULT
             IF iRet <> %S_OK  THEN
            ' this has always been fatal in my tests
                szErrmsg = LEFT$ (USING$ ("Can't attach file # '&'", I,  IDISPINFO.DESC$), cberrMsg-1)
                LET oOutlookApp = NOTHING  ' free all
                FUNCTION = %TRUE
                EXIT FUNCTION
            END IF
        NEXT I

   END IF ' if any attachments

   ' ---------------------
   ' GET DISPOSITION
   ' ----------------------

   IF iDisposition = %EMAIL_DISP_SEND THEN
       W = "SEND"
       OBJECT CALL oMAilItem.Send
   ELSEIF iDisposition  = %EMAIL_DISP_DISPLAY THEN
        W = "DISPLAY"
        OBJECT CALL oMAilItem.Display
   END IF

   iREt = OBJRESULT
   STDOUT USING$("EMail disposition (&) Result # ", W, iRet)
   IF OBJRESULT   = %DISP_E_EXCEPTION THEN
        szErrMSg = LEFT$(USING$ ("Email disposition error (&) &", W, IDISPINFO.DESC$), cbErrMSg)
        FUNCTION = %TRUE
        ' no need to exit, this was last step anyway.
   END IF

OutlookSendEmail_Exit:
   oMailItem     = NOTHING
   oOutLookApp   = NOTHING       ' should I do this if I get existing instance?


END FUNCTION


#IF 0
' THIS FUNCTION NOT USED  ANYMORE

' --------------------------------------------
FUNCTION GetIDispInfoErrorText () AS  STRING

  LOCAL S AS STRING
  LOCAL w AS STRING

  W = FORMAT$(IDISPINFO.CODE)
  S = USING$ ("DispInfo Code '&'", w)
  W = FORMAT$(IDISPINFO.CONTEXT)
  S = s & $CRLF & USING$ ("DispInfo Context '&'", w)
  W =  IDISPINFO.DESC$
  S = s & $CRLF & USING$ ("DispInfo Description '&'", W)
  W =  IDISPINFO.HELP$
  S = s & $CRLF & USING$ ("DispInfo Help(file) '&'", w)
  W = IDISPINFO.SOURCE$
  S = s & $CRLF & USING$ ("DispInfo Source'&'", W)
  S = s & $CRLF & "End of IDISPINFO error messages for DISP_E_EXCEPTION"

  FUNCTION = S

END FUNCTION
#ENDIF

' END OF FILE OutLookSendEmail.INC.

Attached Files

OUTLOOK_8_IDBIND_OBJECT_LIB.zip (9.7 KB, 30 views)

Announcement

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment:

Leave a comment: