Auto Sending mail using the New M$ Outlook

Marcus Rhodes
Participating Frequently
Forum|Forum|1 year ago
June 19, 2024

I have several customers both on UV and on D3 that have programs that send email. AT is using OLE to talk to outlook.
This has stopped working the second the new outlook was forced on my customers.

Any assistance would be appreciated.

This is the code that Pete sent me years ago that was working

SUBROUTINE AT.SEND.EMAIL.OUTLOOK(ADDRESS, SUBJECT, MESSAGE, ATTACH)
* ADDRESS: recipient's email address
* SUBJECT: one-line email subject
* MESSAGE: multi-line email message (lines separated by AM)
* ATTACH: optional attachment file name
EQU AM TO CHAR(254), VM TO CHAR(253), SVM TO CHAR(252)
EQU ESC TO CHAR(27), STX TO CHAR(2), CR TO CHAR(13)
EQU EM TO CHAR(25)
SCRIPT = ''
*Create our object variables
CALL SAVE.SCREEN('AT')
CRT @(0,20):@(-3):"You have called Outlook to send emails. Remember to say 'Allow' to permit Outlook to actually Send the email"
PRINT "To ":ADDRESS:" ":ATTACH
PRINT "Attachment: ":ATTACH
SCRIPT = SCRIPT : 'Dim OutlookApp as Object' : EM
SCRIPT = SCRIPT : 'Dim MailItem as Object' : EM
SCRIPT = SCRIPT : 'Dim Recipient as Object' : EM
SCRIPT = SCRIPT : 'Dim Attachment as Object' : EM
*Create the Outlook application object
SCRIPT = SCRIPT : 'Set OutLookApp = CreateObject("Outlook.Application")' : EM
*Use the Application object to create our mail object
SCRIPT = SCRIPT : 'Set MailItem = OutLookApp.CreateItem(0)' : EM
*Add recipients to the mail item
ARG = ADDRESS ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I=1 TO N
SCRIPT = SCRIPT:'Set Recipient = Mailitem.Recipients.Add("':ARG:'")':EM
SCRIPT = SCRIPT:'If Not Recipient.Resolve Then': EM
SCRIPT = SCRIPT : ' MsgBox "The recipient did not check out!"' : EM
SCRIPT = SCRIPT : ' Exit Sub' : EM
SCRIPT = SCRIPT : 'End If' : EM
NEXT I
* Add the subject
ARG = SUBJECT ; GOSUB 100
SCRIPT = SCRIPT : 'MailItem.Subject = "' : ARG : '"' : EM
* Add the message - lines are separated by attribute marks
ARG = MESSAGE ; GOSUB 100
SCRIPT = SCRIPT : 'Body = "' : ARG<1> : '"' : EM
N = DCOUNT(ARG, AM)
FOR I = 2 TO N
SCRIPT = SCRIPT : 'Body = Body & Chr$(13) & Chr$(10) & "' : ARG : '"' : EM
NEXT I
SCRIPT = SCRIPT : 'MailItem.Body = Body' : EM
* Add the attachment
IF ATTACH <> '' THEN
ARG = ATTACH ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I = 1 TO N
SCRIPT = SCRIPT : 'MailItem.Attachments.Add "' :ARG : '"' : EM
NEXT I
END
SCRIPT = SCRIPT : 'MailItem.Send' : EM
SCRIPT = SCRIPT : 'Set Attachment = Nothing' : EM
SCRIPT = SCRIPT : 'Set Recipient = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing'
PRINT ESC : STX : 'P' : SCRIPT : CR :
CRT @(0,23):@(-4):"Finished Sending Mail to ":ADDRESS
RQM
CALL RESTORE.SCREEN('AT')
RETURN
100:* Local subroutine to fixup embedded double-quote marks
K = 1
LOOP
J = INDEX(ARG, '"', K)
WHILE J DO
ARG = ARG[1, J] : ARG[J, 99999]
K = K + 2
REPEAT
RETURN

Have you tried mutt on the host instead of using a mail client on the client?

Like

Peter Cheney
Participating Frequently
Forum|Forum|1 year ago
June 19, 2024

I have several customers both on UV and on D3 that have programs that send email. AT is using OLE to talk to outlook.
This has stopped working the second the new outlook was forced on my customers.

Any assistance would be appreciated.

This is the code that Pete sent me years ago that was working

SUBROUTINE AT.SEND.EMAIL.OUTLOOK(ADDRESS, SUBJECT, MESSAGE, ATTACH)
* ADDRESS: recipient's email address
* SUBJECT: one-line email subject
* MESSAGE: multi-line email message (lines separated by AM)
* ATTACH: optional attachment file name
EQU AM TO CHAR(254), VM TO CHAR(253), SVM TO CHAR(252)
EQU ESC TO CHAR(27), STX TO CHAR(2), CR TO CHAR(13)
EQU EM TO CHAR(25)
SCRIPT = ''
*Create our object variables
CALL SAVE.SCREEN('AT')
CRT @(0,20):@(-3):"You have called Outlook to send emails. Remember to say 'Allow' to permit Outlook to actually Send the email"
PRINT "To ":ADDRESS:" ":ATTACH
PRINT "Attachment: ":ATTACH
SCRIPT = SCRIPT : 'Dim OutlookApp as Object' : EM
SCRIPT = SCRIPT : 'Dim MailItem as Object' : EM
SCRIPT = SCRIPT : 'Dim Recipient as Object' : EM
SCRIPT = SCRIPT : 'Dim Attachment as Object' : EM
*Create the Outlook application object
SCRIPT = SCRIPT : 'Set OutLookApp = CreateObject("Outlook.Application")' : EM
*Use the Application object to create our mail object
SCRIPT = SCRIPT : 'Set MailItem = OutLookApp.CreateItem(0)' : EM
*Add recipients to the mail item
ARG = ADDRESS ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I=1 TO N
SCRIPT = SCRIPT:'Set Recipient = Mailitem.Recipients.Add("':ARG:'")':EM
SCRIPT = SCRIPT:'If Not Recipient.Resolve Then': EM
SCRIPT = SCRIPT : ' MsgBox "The recipient did not check out!"' : EM
SCRIPT = SCRIPT : ' Exit Sub' : EM
SCRIPT = SCRIPT : 'End If' : EM
NEXT I
* Add the subject
ARG = SUBJECT ; GOSUB 100
SCRIPT = SCRIPT : 'MailItem.Subject = "' : ARG : '"' : EM
* Add the message - lines are separated by attribute marks
ARG = MESSAGE ; GOSUB 100
SCRIPT = SCRIPT : 'Body = "' : ARG<1> : '"' : EM
N = DCOUNT(ARG, AM)
FOR I = 2 TO N
SCRIPT = SCRIPT : 'Body = Body & Chr$(13) & Chr$(10) & "' : ARG : '"' : EM
NEXT I
SCRIPT = SCRIPT : 'MailItem.Body = Body' : EM
* Add the attachment
IF ATTACH <> '' THEN
ARG = ATTACH ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I = 1 TO N
SCRIPT = SCRIPT : 'MailItem.Attachments.Add "' :ARG : '"' : EM
NEXT I
END
SCRIPT = SCRIPT : 'MailItem.Send' : EM
SCRIPT = SCRIPT : 'Set Attachment = Nothing' : EM
SCRIPT = SCRIPT : 'Set Recipient = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing'
PRINT ESC : STX : 'P' : SCRIPT : CR :
CRT @(0,23):@(-4):"Finished Sending Mail to ":ADDRESS
RQM
CALL RESTORE.SCREEN('AT')
RETURN
100:* Local subroutine to fixup embedded double-quote marks
K = 1
LOOP
J = INDEX(ARG, '"', K)
WHILE J DO
ARG = ARG[1, J] : ARG[J, 99999]
K = K + 2
REPEAT
RETURN

Wondering does this code make the windows PC send the mail from the local outlook? So the "PRINT ESC : STX : 'P' : SCRIPT : CR :" causes your terminal emulator to send email via outlook on the local PC? Wow I've never seen how that's done before as I've always used sendmail to create/send from the UV server.

If I was to troubleshoot this I'd be writing the SCRIPT away to some file so I could look at it and see what it looks like and try and understand how it does what it's trying to do. Another thing I'd be checking is if the terminal emulator has also been updated which may be related. Also is there any documentation available for "driving" lookout to make new and send new emails? You must be able to script this from a windows powershell or something so there should be some info somewhere on how to do that. Check this against what your SCRIPT looks like and see what's missing?

Cheers,
Peter

Like

+2

Manu Fernandes
Inspiring
Forum|Forum|1 year ago
June 20, 2024

I have several customers both on UV and on D3 that have programs that send email. AT is using OLE to talk to outlook.
This has stopped working the second the new outlook was forced on my customers.

Any assistance would be appreciated.

This is the code that Pete sent me years ago that was working

SUBROUTINE AT.SEND.EMAIL.OUTLOOK(ADDRESS, SUBJECT, MESSAGE, ATTACH)
* ADDRESS: recipient's email address
* SUBJECT: one-line email subject
* MESSAGE: multi-line email message (lines separated by AM)
* ATTACH: optional attachment file name
EQU AM TO CHAR(254), VM TO CHAR(253), SVM TO CHAR(252)
EQU ESC TO CHAR(27), STX TO CHAR(2), CR TO CHAR(13)
EQU EM TO CHAR(25)
SCRIPT = ''
*Create our object variables
CALL SAVE.SCREEN('AT')
CRT @(0,20):@(-3):"You have called Outlook to send emails. Remember to say 'Allow' to permit Outlook to actually Send the email"
PRINT "To ":ADDRESS:" ":ATTACH
PRINT "Attachment: ":ATTACH
SCRIPT = SCRIPT : 'Dim OutlookApp as Object' : EM
SCRIPT = SCRIPT : 'Dim MailItem as Object' : EM
SCRIPT = SCRIPT : 'Dim Recipient as Object' : EM
SCRIPT = SCRIPT : 'Dim Attachment as Object' : EM
*Create the Outlook application object
SCRIPT = SCRIPT : 'Set OutLookApp = CreateObject("Outlook.Application")' : EM
*Use the Application object to create our mail object
SCRIPT = SCRIPT : 'Set MailItem = OutLookApp.CreateItem(0)' : EM
*Add recipients to the mail item
ARG = ADDRESS ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I=1 TO N
SCRIPT = SCRIPT:'Set Recipient = Mailitem.Recipients.Add("':ARG:'")':EM
SCRIPT = SCRIPT:'If Not Recipient.Resolve Then': EM
SCRIPT = SCRIPT : ' MsgBox "The recipient did not check out!"' : EM
SCRIPT = SCRIPT : ' Exit Sub' : EM
SCRIPT = SCRIPT : 'End If' : EM
NEXT I
* Add the subject
ARG = SUBJECT ; GOSUB 100
SCRIPT = SCRIPT : 'MailItem.Subject = "' : ARG : '"' : EM
* Add the message - lines are separated by attribute marks
ARG = MESSAGE ; GOSUB 100
SCRIPT = SCRIPT : 'Body = "' : ARG<1> : '"' : EM
N = DCOUNT(ARG, AM)
FOR I = 2 TO N
SCRIPT = SCRIPT : 'Body = Body & Chr$(13) & Chr$(10) & "' : ARG : '"' : EM
NEXT I
SCRIPT = SCRIPT : 'MailItem.Body = Body' : EM
* Add the attachment
IF ATTACH <> '' THEN
ARG = ATTACH ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I = 1 TO N
SCRIPT = SCRIPT : 'MailItem.Attachments.Add "' :ARG : '"' : EM
NEXT I
END
SCRIPT = SCRIPT : 'MailItem.Send' : EM
SCRIPT = SCRIPT : 'Set Attachment = Nothing' : EM
SCRIPT = SCRIPT : 'Set Recipient = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing'
PRINT ESC : STX : 'P' : SCRIPT : CR :
CRT @(0,23):@(-4):"Finished Sending Mail to ":ADDRESS
RQM
CALL RESTORE.SCREEN('AT')
RETURN
100:* Local subroutine to fixup embedded double-quote marks
K = 1
LOOP
J = INDEX(ARG, '"', K)
WHILE J DO
ARG = ARG[1, J] : ARG[J, 99999]
K = K + 2
REPEAT
RETURN

Hi,

For our client running 365 we write a subr to send emails from host UV/Basic via MS-Graph REST http request.

The sent emails are in the 'sent' folder of user's 365 account.

Are you interrested ?

Manu

Like

+2

Manu Fernandes
Inspiring
Forum|Forum|1 year ago
June 20, 2024

I have several customers both on UV and on D3 that have programs that send email. AT is using OLE to talk to outlook.
This has stopped working the second the new outlook was forced on my customers.

Any assistance would be appreciated.

This is the code that Pete sent me years ago that was working

SUBROUTINE AT.SEND.EMAIL.OUTLOOK(ADDRESS, SUBJECT, MESSAGE, ATTACH)
* ADDRESS: recipient's email address
* SUBJECT: one-line email subject
* MESSAGE: multi-line email message (lines separated by AM)
* ATTACH: optional attachment file name
EQU AM TO CHAR(254), VM TO CHAR(253), SVM TO CHAR(252)
EQU ESC TO CHAR(27), STX TO CHAR(2), CR TO CHAR(13)
EQU EM TO CHAR(25)
SCRIPT = ''
*Create our object variables
CALL SAVE.SCREEN('AT')
CRT @(0,20):@(-3):"You have called Outlook to send emails. Remember to say 'Allow' to permit Outlook to actually Send the email"
PRINT "To ":ADDRESS:" ":ATTACH
PRINT "Attachment: ":ATTACH
SCRIPT = SCRIPT : 'Dim OutlookApp as Object' : EM
SCRIPT = SCRIPT : 'Dim MailItem as Object' : EM
SCRIPT = SCRIPT : 'Dim Recipient as Object' : EM
SCRIPT = SCRIPT : 'Dim Attachment as Object' : EM
*Create the Outlook application object
SCRIPT = SCRIPT : 'Set OutLookApp = CreateObject("Outlook.Application")' : EM
*Use the Application object to create our mail object
SCRIPT = SCRIPT : 'Set MailItem = OutLookApp.CreateItem(0)' : EM
*Add recipients to the mail item
ARG = ADDRESS ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I=1 TO N
SCRIPT = SCRIPT:'Set Recipient = Mailitem.Recipients.Add("':ARG:'")':EM
SCRIPT = SCRIPT:'If Not Recipient.Resolve Then': EM
SCRIPT = SCRIPT : ' MsgBox "The recipient did not check out!"' : EM
SCRIPT = SCRIPT : ' Exit Sub' : EM
SCRIPT = SCRIPT : 'End If' : EM
NEXT I
* Add the subject
ARG = SUBJECT ; GOSUB 100
SCRIPT = SCRIPT : 'MailItem.Subject = "' : ARG : '"' : EM
* Add the message - lines are separated by attribute marks
ARG = MESSAGE ; GOSUB 100
SCRIPT = SCRIPT : 'Body = "' : ARG<1> : '"' : EM
N = DCOUNT(ARG, AM)
FOR I = 2 TO N
SCRIPT = SCRIPT : 'Body = Body & Chr$(13) & Chr$(10) & "' : ARG : '"' : EM
NEXT I
SCRIPT = SCRIPT : 'MailItem.Body = Body' : EM
* Add the attachment
IF ATTACH <> '' THEN
ARG = ATTACH ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I = 1 TO N
SCRIPT = SCRIPT : 'MailItem.Attachments.Add "' :ARG : '"' : EM
NEXT I
END
SCRIPT = SCRIPT : 'MailItem.Send' : EM
SCRIPT = SCRIPT : 'Set Attachment = Nothing' : EM
SCRIPT = SCRIPT : 'Set Recipient = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing'
PRINT ESC : STX : 'P' : SCRIPT : CR :
CRT @(0,23):@(-4):"Finished Sending Mail to ":ADDRESS
RQM
CALL RESTORE.SCREEN('AT')
RETURN
100:* Local subroutine to fixup embedded double-quote marks
K = 1
LOOP
J = INDEX(ARG, '"', K)
WHILE J DO
ARG = ARG[1, J] : ARG[J, 99999]
K = K + 2
REPEAT
RETURN

Hello

Recently Many users switch their exchange system to Microsoft 365.

To send emails we write a subr on server side which use MS-Graph http rest to send the emails.

The sent emails are sent and stores into the 'sent' folder of the usermailbox.

Are you interrested ?

Manu

Like

Chris Wolcz
Participating Frequently
Forum|Forum|1 year ago
June 21, 2024

I have several customers both on UV and on D3 that have programs that send email. AT is using OLE to talk to outlook.
This has stopped working the second the new outlook was forced on my customers.

Any assistance would be appreciated.

This is the code that Pete sent me years ago that was working

SUBROUTINE AT.SEND.EMAIL.OUTLOOK(ADDRESS, SUBJECT, MESSAGE, ATTACH)
* ADDRESS: recipient's email address
* SUBJECT: one-line email subject
* MESSAGE: multi-line email message (lines separated by AM)
* ATTACH: optional attachment file name
EQU AM TO CHAR(254), VM TO CHAR(253), SVM TO CHAR(252)
EQU ESC TO CHAR(27), STX TO CHAR(2), CR TO CHAR(13)
EQU EM TO CHAR(25)
SCRIPT = ''
*Create our object variables
CALL SAVE.SCREEN('AT')
CRT @(0,20):@(-3):"You have called Outlook to send emails. Remember to say 'Allow' to permit Outlook to actually Send the email"
PRINT "To ":ADDRESS:" ":ATTACH
PRINT "Attachment: ":ATTACH
SCRIPT = SCRIPT : 'Dim OutlookApp as Object' : EM
SCRIPT = SCRIPT : 'Dim MailItem as Object' : EM
SCRIPT = SCRIPT : 'Dim Recipient as Object' : EM
SCRIPT = SCRIPT : 'Dim Attachment as Object' : EM
*Create the Outlook application object
SCRIPT = SCRIPT : 'Set OutLookApp = CreateObject("Outlook.Application")' : EM
*Use the Application object to create our mail object
SCRIPT = SCRIPT : 'Set MailItem = OutLookApp.CreateItem(0)' : EM
*Add recipients to the mail item
ARG = ADDRESS ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I=1 TO N
SCRIPT = SCRIPT:'Set Recipient = Mailitem.Recipients.Add("':ARG:'")':EM
SCRIPT = SCRIPT:'If Not Recipient.Resolve Then': EM
SCRIPT = SCRIPT : ' MsgBox "The recipient did not check out!"' : EM
SCRIPT = SCRIPT : ' Exit Sub' : EM
SCRIPT = SCRIPT : 'End If' : EM
NEXT I
* Add the subject
ARG = SUBJECT ; GOSUB 100
SCRIPT = SCRIPT : 'MailItem.Subject = "' : ARG : '"' : EM
* Add the message - lines are separated by attribute marks
ARG = MESSAGE ; GOSUB 100
SCRIPT = SCRIPT : 'Body = "' : ARG<1> : '"' : EM
N = DCOUNT(ARG, AM)
FOR I = 2 TO N
SCRIPT = SCRIPT : 'Body = Body & Chr$(13) & Chr$(10) & "' : ARG : '"' : EM
NEXT I
SCRIPT = SCRIPT : 'MailItem.Body = Body' : EM
* Add the attachment
IF ATTACH <> '' THEN
ARG = ATTACH ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I = 1 TO N
SCRIPT = SCRIPT : 'MailItem.Attachments.Add "' :ARG : '"' : EM
NEXT I
END
SCRIPT = SCRIPT : 'MailItem.Send' : EM
SCRIPT = SCRIPT : 'Set Attachment = Nothing' : EM
SCRIPT = SCRIPT : 'Set Recipient = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing'
PRINT ESC : STX : 'P' : SCRIPT : CR :
CRT @(0,23):@(-4):"Finished Sending Mail to ":ADDRESS
RQM
CALL RESTORE.SCREEN('AT')
RETURN
100:* Local subroutine to fixup embedded double-quote marks
K = 1
LOOP
J = INDEX(ARG, '"', K)
WHILE J DO
ARG = ARG[1, J] : ARG[J, 99999]
K = K + 2
REPEAT
RETURN

We have a .Net app that sends emails in the background from D3. If you need to send emails more interactively, have you consider using Python? Here is a sample code.

import smtplib
from email.mime.text import MIMEText
from email.mime.multipart import MIMEMultipart

def send_email(sender_email, sender_password, receiver_email, subject, body):
# Outlook SMTP server address and port
smtp_server = 'smtp-mail.outlook.com'
smtp_port = 587 # Port for STARTTLS

# Create a MIMEText object to represent the email
message = MIMEMultipart()
message['From'] = sender_email
message['To'] = receiver_email
message['Subject'] = subject
message.attach(MIMEText(body, 'plain'))

try:
# Establish a secure session with Outlook's SMTP server
server = smtplib.SMTP(smtp_server, smtp_port)
server.starttls() # Enable encryption for the connection
# Login using your Outlook email address and password
server.login(sender_email, sender_password)
# Send the email
server.sendmail(sender_email, receiver_email, message.as_string())
print('Email sent successfully!')
except Exception as e:
print(f'Failed to send email. Error: {str(e)}')
finally:
server.quit() # Terminate the SMTP session

# Example usage:
if __name__ == "__main__":
sender_email = 'your_outlook_email@example.com'
sender_password = 'your_outlook_password'
receiver_email = 'recipient@example.com'
subject = 'Test Email from Python'
body = 'Hello, this is a test email sent from Python using Outlook SMTP.'

send_email(sender_email, sender_password, receiver_email, subject, body)

Like

David Williams
Participating Frequently
Forum|Forum|1 year ago
June 21, 2024

I have several customers both on UV and on D3 that have programs that send email. AT is using OLE to talk to outlook.
This has stopped working the second the new outlook was forced on my customers.

Any assistance would be appreciated.

This is the code that Pete sent me years ago that was working

SUBROUTINE AT.SEND.EMAIL.OUTLOOK(ADDRESS, SUBJECT, MESSAGE, ATTACH)
* ADDRESS: recipient's email address
* SUBJECT: one-line email subject
* MESSAGE: multi-line email message (lines separated by AM)
* ATTACH: optional attachment file name
EQU AM TO CHAR(254), VM TO CHAR(253), SVM TO CHAR(252)
EQU ESC TO CHAR(27), STX TO CHAR(2), CR TO CHAR(13)
EQU EM TO CHAR(25)
SCRIPT = ''
*Create our object variables
CALL SAVE.SCREEN('AT')
CRT @(0,20):@(-3):"You have called Outlook to send emails. Remember to say 'Allow' to permit Outlook to actually Send the email"
PRINT "To ":ADDRESS:" ":ATTACH
PRINT "Attachment: ":ATTACH
SCRIPT = SCRIPT : 'Dim OutlookApp as Object' : EM
SCRIPT = SCRIPT : 'Dim MailItem as Object' : EM
SCRIPT = SCRIPT : 'Dim Recipient as Object' : EM
SCRIPT = SCRIPT : 'Dim Attachment as Object' : EM
*Create the Outlook application object
SCRIPT = SCRIPT : 'Set OutLookApp = CreateObject("Outlook.Application")' : EM
*Use the Application object to create our mail object
SCRIPT = SCRIPT : 'Set MailItem = OutLookApp.CreateItem(0)' : EM
*Add recipients to the mail item
ARG = ADDRESS ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I=1 TO N
SCRIPT = SCRIPT:'Set Recipient = Mailitem.Recipients.Add("':ARG:'")':EM
SCRIPT = SCRIPT:'If Not Recipient.Resolve Then': EM
SCRIPT = SCRIPT : ' MsgBox "The recipient did not check out!"' : EM
SCRIPT = SCRIPT : ' Exit Sub' : EM
SCRIPT = SCRIPT : 'End If' : EM
NEXT I
* Add the subject
ARG = SUBJECT ; GOSUB 100
SCRIPT = SCRIPT : 'MailItem.Subject = "' : ARG : '"' : EM
* Add the message - lines are separated by attribute marks
ARG = MESSAGE ; GOSUB 100
SCRIPT = SCRIPT : 'Body = "' : ARG<1> : '"' : EM
N = DCOUNT(ARG, AM)
FOR I = 2 TO N
SCRIPT = SCRIPT : 'Body = Body & Chr$(13) & Chr$(10) & "' : ARG : '"' : EM
NEXT I
SCRIPT = SCRIPT : 'MailItem.Body = Body' : EM
* Add the attachment
IF ATTACH <> '' THEN
ARG = ATTACH ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I = 1 TO N
SCRIPT = SCRIPT : 'MailItem.Attachments.Add "' :ARG : '"' : EM
NEXT I
END
SCRIPT = SCRIPT : 'MailItem.Send' : EM
SCRIPT = SCRIPT : 'Set Attachment = Nothing' : EM
SCRIPT = SCRIPT : 'Set Recipient = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing'
PRINT ESC : STX : 'P' : SCRIPT : CR :
CRT @(0,23):@(-4):"Finished Sending Mail to ":ADDRESS
RQM
CALL RESTORE.SCREEN('AT')
RETURN
100:* Local subroutine to fixup embedded double-quote marks
K = 1
LOOP
J = INDEX(ARG, '"', K)
WHILE J DO
ARG = ARG[1, J] : ARG[J, 99999]
K = K + 2
REPEAT
RETURN

Well to use Ms 365 and send emails. I found I have to turn off MFA for that particular mail box. I used Edoc to create PDF's with a template overlay. Then let that program do the heavy lifting. You only need a few lines of code after it's set up and it looks really pretty. Plus you can seal or encrypt the PDF if you're sending sensitive info.

Like

+3

Henry Unger
Inspiring
Forum|Forum|1 year ago
June 21, 2024

I have several customers both on UV and on D3 that have programs that send email. AT is using OLE to talk to outlook.
This has stopped working the second the new outlook was forced on my customers.

Any assistance would be appreciated.

This is the code that Pete sent me years ago that was working

SUBROUTINE AT.SEND.EMAIL.OUTLOOK(ADDRESS, SUBJECT, MESSAGE, ATTACH)
* ADDRESS: recipient's email address
* SUBJECT: one-line email subject
* MESSAGE: multi-line email message (lines separated by AM)
* ATTACH: optional attachment file name
EQU AM TO CHAR(254), VM TO CHAR(253), SVM TO CHAR(252)
EQU ESC TO CHAR(27), STX TO CHAR(2), CR TO CHAR(13)
EQU EM TO CHAR(25)
SCRIPT = ''
*Create our object variables
CALL SAVE.SCREEN('AT')
CRT @(0,20):@(-3):"You have called Outlook to send emails. Remember to say 'Allow' to permit Outlook to actually Send the email"
PRINT "To ":ADDRESS:" ":ATTACH
PRINT "Attachment: ":ATTACH
SCRIPT = SCRIPT : 'Dim OutlookApp as Object' : EM
SCRIPT = SCRIPT : 'Dim MailItem as Object' : EM
SCRIPT = SCRIPT : 'Dim Recipient as Object' : EM
SCRIPT = SCRIPT : 'Dim Attachment as Object' : EM
*Create the Outlook application object
SCRIPT = SCRIPT : 'Set OutLookApp = CreateObject("Outlook.Application")' : EM
*Use the Application object to create our mail object
SCRIPT = SCRIPT : 'Set MailItem = OutLookApp.CreateItem(0)' : EM
*Add recipients to the mail item
ARG = ADDRESS ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I=1 TO N
SCRIPT = SCRIPT:'Set Recipient = Mailitem.Recipients.Add("':ARG:'")':EM
SCRIPT = SCRIPT:'If Not Recipient.Resolve Then': EM
SCRIPT = SCRIPT : ' MsgBox "The recipient did not check out!"' : EM
SCRIPT = SCRIPT : ' Exit Sub' : EM
SCRIPT = SCRIPT : 'End If' : EM
NEXT I
* Add the subject
ARG = SUBJECT ; GOSUB 100
SCRIPT = SCRIPT : 'MailItem.Subject = "' : ARG : '"' : EM
* Add the message - lines are separated by attribute marks
ARG = MESSAGE ; GOSUB 100
SCRIPT = SCRIPT : 'Body = "' : ARG<1> : '"' : EM
N = DCOUNT(ARG, AM)
FOR I = 2 TO N
SCRIPT = SCRIPT : 'Body = Body & Chr$(13) & Chr$(10) & "' : ARG : '"' : EM
NEXT I
SCRIPT = SCRIPT : 'MailItem.Body = Body' : EM
* Add the attachment
IF ATTACH <> '' THEN
ARG = ATTACH ; GOSUB 100
N = DCOUNT(ARG, AM)
FOR I = 1 TO N
SCRIPT = SCRIPT : 'MailItem.Attachments.Add "' :ARG : '"' : EM
NEXT I
END
SCRIPT = SCRIPT : 'MailItem.Send' : EM
SCRIPT = SCRIPT : 'Set Attachment = Nothing' : EM
SCRIPT = SCRIPT : 'Set Recipient = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing' : EM
SCRIPT = SCRIPT : 'Set MailItem = Nothing'
PRINT ESC : STX : 'P' : SCRIPT : CR :
CRT @(0,23):@(-4):"Finished Sending Mail to ":ADDRESS
RQM
CALL RESTORE.SCREEN('AT')
RETURN
100:* Local subroutine to fixup embedded double-quote marks
K = 1
LOOP
J = INDEX(ARG, '"', K)
WHILE J DO
ARG = ARG[1, J] : ARG[J, 99999]
K = K + 2
REPEAT
RETURN