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
SEND EMAIL INCLUDE FILE
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
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.
Comment