Showing results for 
Search instead for 
Do you mean 
Community Home Request Access Read Blogs Share Your Ideas Search Community View My Settings
Reply
New Member
Posts: 2
Registered: ‎02-14-2010

Send Email via ActiveScript?

We just upgraded a client from 5.2 to 7.5.4 LAN, and I'm having trouble getting a script to work in the new version.  I'll paste it below.

 

Various scripts in SLX set global variables for the recipient, subject and body, and then they initiate a generic SendMail script that delivers the email in the background without user intervention (which is required, we don't want the user preventing certain emails from going out).  We get an error when the script tries to add the recipients to the object.

 

What's the best way to do this in 7.5.4?  Is this approach not possible in 7.5.4 now?  QueMessage won't work because it prompts the user with the email message, we need the message sent automatically.  Is there something I need to tweak in the existing script to make it work?

 

Thanks in advance for your help.

 

Cheryl

 

-----

 

sub main
     'Outlook variables
     Dim olApp As Object
     Dim mailItem As Object
     Dim strRec1 as String
     Dim strRec2 as String

 

     'Mail Item variables
     Dim strSubject as String 'The subject line of the email
     Dim strBody as String 'The actual text of the email
     Dim strRecipient as String 'Who you're sending the email to
     Dim iPos as Integer

     'Set Mail Item variables
     GlobalInfoFor "SendMail_Recipient", strRecipient
     If IsNull(strRecipient) = True then
          strRecipient = "defaultuser@company.com"
     End If
     GlobalInfoFor "SendMail_Subject", strSubject
     GlobalInfoFor "SendMail_Body", strBody

     

     'Open Outlook & set up Mail Item
     Set olApp = CreateObject("Outlook.Application")
     Set mailItem = olApp.CreateItem(olMailItem)

 

     'Add recipients, there will only be up to two, separated by a semi-colon
     iPos = InStr(1, strRecipient, ";")
     If iPos > 0 Then
          strRec1 = Left(strRecipient,iPos - 1)
          mailItem.Recipients.Add(strRec1)
          strRec2 = mid(strRecipient, iPos + 1, Len(strRecipient))
          mailItem.Recipients.Add(strRec2)
     Else
          mailItem.Recipients.Add(strRecipient)
     End If

 

     'Set body text and subject line
     mailItem.Subject = strSubject
     mailItem.Body = strBody

 

     'Send it
     mailItem.Send
     Set olApp = Nothing

 

end sub

-----

Nickel Contributor
Posts: 90
Registered: ‎03-20-2009

Re: Send Email via ActiveScript?

[ Edited ]

Here is a sub that we use.  It relys on CDO, so use at your own discretion....

 

There is a section about half way down that you will have to include your server settings in.....

 

Sub SendOutlookMessageSilently(byVal strToAddress, byVal strCCAddress, byVal strBCCAddress, byVal strSubject, byVal strBody, byVal strAttachment)
    ' Added SSI jlp 03/08/2013
    ' Subroutine to silently send an Outlook mail messaage
    ' To pass in multiple attachments, seperate each file name with a "|" character
    ' Sub ASSUMES that the attachments being passed in are valid files.....
    Dim objOA               ' Outlook Application object
    Dim objMailItem         ' Outlook Mail Item

    ' Turn off error handling
    On Error Resume Next

    ' Establish initial object
    Set objOA = CreateObject("Outlook.Application")
    If objOA is Nothing then
        ' Complain if Outlook is not open
        msgbox "Please open Outlook before continuing", vbExclamation, "Outlook Not Running"
        Exit Sub
    End if

    ' Turn error handling back on
    On Error Goto 0

    ' Dimension variables
    Dim strFrom
    Dim strServer
    Dim strUser
    Dim strPassword
    Dim strPort
    Dim objMessage

    Set objMessage = CreateObject("CDO.Message")

    ' Make sure we have all the values....

'------------------

' We store these in a Management interface to avoid hardcoding, but you could just hardcode your values here....

'------------------
    strFrom = "" & GetField("EMAIL_FROM", "PROJ_MGMT_SETTINGS", "Proj_Mgmt_SettingsID = 'PROJMGMT0001'")
    strServer = "" & GetField("SMTP_SERVER_NAME", "PROJ_MGMT_SETTINGS", "Proj_Mgmt_SettingsID = 'PROJMGMT0001'")
    strUser = "" & GetField("SMTP_USER_ID", "PROJ_MGMT_SETTINGS", "Proj_Mgmt_SettingsID = 'PROJMGMT0001'")
    strPassword = "" & GetField("SMTP_USER_PASSWORD", "PROJ_MGMT_SETTINGS", "Proj_Mgmt_SettingsID = 'PROJMGMT0001'")
    strPort = "" & GetField("SMTP_PORT_NUMBER", "PROJ_MGMT_SETTINGS", "Proj_Mgmt_SettingsID = 'PROJMGMT0001'")

    If strServer = "" or strUser = "" or strPassword = "" or strPort = "" then
       ' Complain and exit sub, even though we are this close....
       msgbox "E-Mail server settings are not defined.  Please set the server settings and retry the e-mail", vbCritical, "Mail server settings missing"
       Exit Sub
    End if

    ' Set From field....
    If strFrom <> "" then
       objMessage.From = strFrom
    End if
    ' Set to field....
    If strToAddress <> "" then
       objMessage.To = strToAddress
    End if
    ' Set CC field....
    If strCCAddress <> "" then
       objMessage.CC = strCCAddress
    End if
    objMessage.Subject = strSubject
    objMessage.TextBody = strBody

    '==This section provides the configuration information for the remote SMTP server.

    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

    'Name or IP of Remote SMTP Server
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strServer

    'Type of authentication, NONE, Basic (Base64 encoded), NTLM
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'cdoBasic

    'Your UserID on the SMTP server
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUser

    'Your password on the SMTP server
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strPassword

    'Server port (typically 25)
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CInt(strPort) ' must be an integer from testing

    'Use SSL for the connection (False or True)
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False

    'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
    objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

    '==End remote SMTP server configuration section==

    ' Update all settings....
    objMessage.Configuration.Fields.Update

    objMessage.Send

    Set objMessage = Nothing

    If Not(ErrorCheck("E-Mail failed to send.")) then
        ' Set the Email Sent control.....
        txtEmailSent.Text = "Sent"
    End if
End Sub

 

Jim Pemberton
Vice President of Engineering
Simplesoft Solutions, Inc
Award Winning Infor CRM Business Partner
Silver Super Contributor
Posts: 801
Registered: ‎03-24-2009

Re: Send Email via ActiveScript?

What was the error you received? I'm guessing it's an address book/contact issue. This is down to Outlook preventing programmatic access (due to virus/Trojans etc). The only way around that is by using something called Outlook Redemption. Otherwise, let us know what the err is.
Gold Super Contributor
Posts: 3,087
Registered: ‎03-19-2009

Re: Send Email via ActiveScript?

Here's something I've been using for my customers. It's setup as an Include File so we can re-use it:

 

 

option explicit
'TheToolBoxXForEmail - RJLedger
' © 2004 - 2014 RJLSYSTEMS, LLC All Rights Reserved.

'
'
' Sends an Outlook Email message - very simple version
'
'Usage If SendOutlookMail("Test Mail", "rjledger@gmail.com", "Test Message") Then
'      End If
'  or  SendOutlookMail "Test Mail", "rjledger@gmail.com", "Test Message"
'
Function SendOutlookMail(byval strSubject, byval strToAddress, byval strMessage)
  Dim objOutlook
  Dim objItem

  Set objOutlook = CreateObject("Outlook.Application")
  Set objItem = objOutlook.createitem(0)
  With objItem
    .Subject = strSubject
    .To = strToAddress
    .body = strMessage
    .Send
  End With

  Set objOutlook = Nothing
  Set objItem = Nothing
End function

'
'Advanced version of Send email via Outlook - by default stops w/the email message "displayed"
'
' Subroutine to replace Application.BasicFunctions.QueMessage that is broken.. well. very limited..
'Usage:
'strToAddress
'strCCAddress
'strBCCAddress
'Dim strSubject
'Dim strBody 'can be plain text or HTML - IF blnHTML flag is True ;-)
'Dim blnHTML 'signifies strBody is HTML encoded
'Dim strAttachment() 'starting w/strAttachment(1)
'Dim intAttachmentCount
'Dim blnSend ' True if send NOW - False/empty/blank if just popup email send window
'strResult
'strResult = SendOutlookMessage(strToAddress,strCCAddress,strBCCAddress,strSubject,strBody,blnHTML,strAttachment,intAttachmentCount,blnSend)
'strResult can be:
'  NO_SUBJECT, NO_RECIPIENT,SEND,DISPLAY
Function SendOutlookMessage(byVal strToAddress, byVal strCCAddress, byVal strBCCAddress, byVal strSubject, byVal strBody, byVal blnHTML, ByRef strAttachment, byVal intAttachmentCount, byVal blnSend)
  Dim objOA               ' Outlook Application object
  Dim objMailItem         ' Outlook Mail Item
  Dim i

  If trim("" & blnHTML) = "" Then  blnHTML = True
  'Have to have a subject... SPAM issue(s)
  If Trim("" & strSubject) = "" Then
    SendOutlookMessage = "NO_SUBJECT"
    Exit Function
  End If

  'Autosend?
  If Trim("" & blnSend) = "" Then blnSend = False
  'Have to have a "to".. even if we have a "cc" or a "bcc" - safety issue
  If Trim("" & strToAddress) = "" Then
    SendOutlookMessage = "NO_RECIPIENT"
        Exit Function
  End If

  ' Establish initial object
  Set objOA = CreateObject("Outlook.Application")

  ' Establish Mail Item to build the actual e-mail
  Set objMailItem = objOA.CreateItem(0) ' olMailItem

  ' Build the actual e-mail
  With objMailItem
    ' Set the header....
    .To = strToAddress
    .CC = strCCAddress
    .BCC = strBCCAddress
    .Subject = strSubject

    ' And the meat of the e-mail
    If NOT blnHTML then
      .Body = strBody
    Else
      .htmlBody = strBody
    End If
    'Attachment(s)
    If Trim("" & intAttachmentCount) = "" Then
      intAttachmentCount = 0
    End If
    For i = 0 to intAttachmentCount -1
      .Attachments.Add strAttachment(i)
    Next
    ' Then show it....maybe..
    If NOT blnSend Then
      .Display
      SendOutlookMessage = "DISPLAY"
    Else
      .Send
      SendOutlookMessage = "SEND"
    End If
  End With

  ' Destroy objects....
  Set objMailItem = Nothing
  Set objOA = Nothing
End Function


'
'Determine if Outlook is installed
'
'Usage:
'Returns True/False
' If no version specified, the installed version info is reported
' Else - returns False if the version specified is NOT the version installed
'Dim strOutlookVersion
'strOutlookVersion = "2007"
'If IsOutlookInstalled("2007") Thne
' 'yes.. have Outlook2007
'Else
' 'No....
'End If
'ANY Outlook
'If IsOutlookInstalled("") Thne
' 'yes.. have Outlook.. but could be any version
'Else
' 'No....
'End If
Function IsOutlookInstalled(ByVal strOutlookVersion)
  Dim objOutlook
  Dim iPos
  Dim iOutlookVersion
  Dim strVersion
  Dim blnInstalled

  on error resume next
  IsOutlookInstalled = False
  blnInstalled = False

  set objOutlook = CreateObject("Outlook.Application")
  If objOutlook is Nothing Then
    'wscript.echo "Outlook is NOT installed or is installed incorrectly"
    Application.Debug.WriteLine "No Outlook"
    Err.clear
    Exit Function
  Else
    'Strip the version info to the major level - ignore builds
    iPos = instr(1, objOutlook.Version,".")
    iOutVersion = Left(objOutlook.Version,iPos) + mid(objOutlook.Version, iPos+1,1)
    Select Case iOutVersion
      Case 9.0
        strVersion = "Outlook 2000"
      Case 10.0
        strVersion = "Outlook 2002"
      Case 11.0
        strVersion = "Outlook 2003"
      Case 12.0
        strVersion = "Outlook 2007"
      Case 13.0
        strVersion = 'No Such Animal"
      Case 14.0
        strVersion = "Outlook 2010"
      Case 15.0
        strVersion = "Outlook 2013"
      Case Else
        'No idea.. so show report the entire version number - including build
        strVersion = Cstr(objOutlook.Version)
    End Select
    blnInstalled = True
    'Show the user
    If Left(strVersion,7) = "Outlook" Then
      blnInstalled = True
      Application.Debug.WriteLine strVersion & " is installed"
    Else
      blnInstalled = True
      Application.Debug.WriteLine "Outlook Version " & strVersion & " is installed"
    End If
    Set objOutlook = Nothing
  End If

  'Check against a passed in version (ex: "2007") to see if the installed version is what we are looking for
  If blnInstalled Then
    If Trim("" & strOutlookVersion) <> "" Then
      'Verify Version
       If strVersion = "Outlook " & strOutlookVersion Then
         IsOutlookInstalled = True
       Else
         blnInstalled = False
       End If
    Else
      '..
    End If
  End If
  IsOutlookInstalled = blnInstalled
End Function

 It has three functions:

   1 - a simple "SendOutlookEmail"

   2 - "SendOutlookMessage" - a more feature rich version

   3 - an test to see if teh version of outlook (installed) is what you expect it to be - "IsOutlookInstalled"

 

.. have fun!

--
RJ Ledger - rjledger@rjlSystems.net +1 603.369.3047 x101

".. Innovators in Mobility - Experts in Workflow Automation..."
http://www.rjlSystems.net - blog: www.rjlSystems.net/blog.html
Highlighted
New Member
Posts: 2
Registered: ‎02-14-2010

Re: Send Email via ActiveScript?

The error was with the Recipients.Add command, comes back invalid.  My guess is/was that the syntax is just different, but couldn't find any info on what the new command would be.  I'm going to try some of the examples posted...