VB6 application connecting to mapi - windows

I have created a VB6 application which contains a service to basically send and receive emails,the service uses a service account and mapi profile configured in Windows 2003 serverR2.
This was working when both exchange server and domain account were in the same network. Once the exchange server got changed the service is unable to send or receive emails giving error
Microsoft Exchange is not available. Either there are network problems or the Exchange computer is down for maintenance. [Microsoft Exchange Information Store - [MAPI_E_FAILONEPROVIDER(8004011D)]], Collaboration Data Objects.
I have searched this error but I wasn't able to gather all as the explanation is for same network.
Anyone could you please advice what can I do to resolve this ?
Thanks,

MAPI has been discontinued by Microsift as suggested by #bob77 also.
I would recommend to use SMTP or EWS.
That being said if you still want to go with it.
Please find the working code below:
Set objMAPI = New MAPI.Session
objMAPI.Logon ShowDialog:=False, NewSession:=False, ProfileInfo:=gobjINI.gstrExchangeServer & vbLf & gobjINI.gstrProfile
'Add a new mesage to the OUtbo Messages Collection
Set objMSG = objMAPI.Outbox.Messages.Add
Set fsoMy_File_Sys_Obj = New FileSystemObject
'Add the recipient list specified in INI File
'Check if this is a multiple Recipient List (names or groups seperated by semicolons!)
If InStr(1, Recipients, ";") Then
objMSG.Recipients.AddMultiple Recipients, CdoTo
objMSG.Recipients.Resolve
Else
'This section is for handling of single recipient name
'Be aware that this may be an email group list name !
Set objRecipients = objMSG.Recipients.Add(Recipients)
objRecipients.Resolve
End If
'Add an attachment if needed
If Attachment_Name <> "" Then
bolAttach_File_Exists = fsoMy_File_Sys_Obj.FileExists(Attachment_Path)
If bolAttach_File_Exists = True Then
'Open the attachment file and add it to the message text
Set tsAttachment = fsoMy_File_Sys_Obj.OpenTextFile(Attachment_Path)
Do While Not tsAttachment.AtEndOfStream
strAttachment_Read = tsAttachment.ReadLine
Message = Message & strAttachment_Read & vbCrLf
Loop
tsAttachment.Close
Else
gobjMAPI.MailSend gobjINI.gstrMailRecipients, "Email Send - Attachment Addition", "Attempted To Attach A File That Does Not Exist", "", ""
End If
End If
'Add Subject Line, Message Content and Send Message
objMSG.Subject = Subject
objMSG.Text = Message
objMSG.Importance = mapiHigh
'The Update method adds all our assignments to collecttion
objMSG.Update
'Now let's actually send the message
objMSG.Send
'End MAPI Session
objMAPI.Logoff
Set objMAPI = Nothing

Related

Pywin32 Outlook Filtering Emails with Restrict "LIKE"

I am trying to make a program that uses the pywin32 library to download attachments from certain emails. I want to filter the messages in the inbox by their sent date, and their sender address domain. So I've tried this method to filter messages by their 'SentOn':
outlook = win32com.client.Dispatch("Outlook.Application").GetNamespace("MAPI")
inbox = outlook.Folders('inbox_name').Folders('Inbox')
messages = inbox.Items
senton = '2022-03-31'
messages = messages.Restrict(f"[SentOn] == {senton}")
This worked properly, but now that I try to filter by SenderEmailAddress using the #SQL syntax, like this:
messages = messages.Restrict("#SQL=(urn:schemas:httpmail:SenderEmailAddress LIKE '%#domain.com')")
I get no results, even though my testing set of messages should have emails sent by addresses cointaining #domain.com for example. What is the problem here? Thanks for the help!
First, you need to remove round brackets from the search criteria:
messages = messages.Restrict("#SQL=""urn:schemas:httpmail:senderemail"" LIKE '%#domain.com'")
If you want to add other conditions you can use the logical AND operation:
messages = messages.Restrict("#SQL=""urn:schemas:httpmail:senderemail"" LIKE '%#domain.com' AND ""urn:schemas:httpmail:date"" > '" & Format(senton, "ddddd h:nn AMPM") & "'")
The date property stands for the date and time on which the message was sent.
See Items.Restrict method for more information.

Attempting to read and download Outlook emails in jupyter notebook using win32

Two-fold issue: 1) Trying to download attachments from Outlook emails using win32 in Jupyter Notebook 2) I get notifications of different lessons and resources by phone. Then I usually, send the URL to the resource to my email to organize later on. Is there a way to use Jupyter Notebook to grab these emails and store them in an excel file? Here is the lesson I am trying to follow currently: https://towardsdatascience.com/automatic-download-email-attachment-with-python-4aa59bc66c25 . And here is my code:
import win32com.client
outlook = win32com.client.Dispatch("Outlook.Application").GetNamespace("MAPI")
inbox = outlook.GetDefaultFolder(6)
messages = inbox.items
message = message.GetFirst()
attachments = message.Attachments
attachment = attachments.Item(1)
attachment_name = str(attachment).lower() attachment.SaveAsFile(path + '\\' + atttachment_name)
exit
You never check that a message has attachments (message.Attachments.Count > 0) and you assume that you get a particular message from the Inbox: can either get the currently selected message (Application.ActiveExplorer.Selection collection) or you need to search for the particular message using Items.Find/FindNext or Items.Restrict. Items.GetLast will give some undetermined item.
Thirdly, the line message = message.GetFirst() was probably meant to be message = messages.GetFirst(). Still won't work, but at least it won't blow up because message variable is uninitialized.

javax.mail.internet.AddressException: Domain contains illegal character in string

While trying to READ the email addressee of an email coming from Outlook:
message.getRecipients(Message.RecipientType.TO)
I am getting following exception:
Caused by: javax.mail.internet.AddressException: Domain contains illegal character in string ``'xxxxx#yyyyyy.com'''
at javax.mail.internet.InternetAddress.checkAddress(InternetAddress.java:1269)
at javax.mail.internet.InternetAddress.parse(InternetAddress.java:1091)
at javax.mail.internet.InternetAddress.parseHeader(InternetAddress.java:658)
at javax.mail.internet.MimeMessage.getAddressHeader(MimeMessage.java:701)
at javax.mail.internet.MimeMessage.getRecipients(MimeMessage.java:534)
The problem is given by this character " ' " at the beginning and at the end of the email address. The problem is that for the outlook server this is a valid address but not for a MimeMessage, so when I am trying to retrieve it and all the checks are applied I am getting the exception.
Please note that I am not creating the message, I am just reading whatever is in the outlook inbox folder through:
Folder inbox = store.getFolder(.......);
messages = inbox.getMessages();
Any idea how to solve/workaround this?
Thank you very much
Sam
I suspect you are using java mail version higher than 1.4 which by defaults enables strict RFC822 syntax
You could able to read email with quotes by disabling "strict" policy on InternetAddress something like this.
Properties props = new Properties();
props.setProperty("mail.mime.address.strict", "false");
Session session = Session.getDefaultInstance(props, ....);
Or simply
new InternetAddress("...", false);

VBA : Paste Word.Table into Outlook email

I have the below VBA code which i run to create a reply email.
Dim Reply As Outlook.MailItem
Dim Original As Outlook.MailItem
Set Original = Application.ActiveExplorer.Selection(1)
Set Reply = Original.ReplyAll
Reply.Subject = "RE: " & Original.Subject
Reply.Display
I have the following variable and have been unsuccessfully trying to paste it into "Reply" above.
Dim tTable As Word.Table
Word is used as an email editor in Outlook. You can use the WordEditor property of the Inspector class to get an instance of the Document class which represents the Body of the email. Thus, you will be able to use objects, their properties and methods available in the Word object model when working with item bodies.
You can read about all possible ways in the Chapter 17: Working with Item Bodies article in MSDN.

Get list of ALM project AND domains names in VBScript (QC11 OTA)

I am trying to list QC11 project and domain name in combo box on form load() but I am getting error object required,code I am using:
Dim tdc As New TDAPIOLELib.TDConnection
Dim projectList As Customization
Dim Project As Customization
Dim Domain As Customization
Set tdc = CreateObject("TDApiOle80.TDConnection")
tdc.InitConnectionEx "https://xyz/omu"
For Each Domain In TheTDConnection.DomainsList
Set projectList = tdc.GetAllVisibleProjectDescriptors
For Each Project In projectList
ComboBox1.AddItem (Project.Name)
ComboBox2.AddItem (Project.DomainName)
Next Project
Next Domain
If that's really the code you are using, then for a start this line is probably generating an error:
For Each Domain In TheTDConnection.DomainsList
Based on the rest of your code "TheTDConnection" should be "tdc":
For Each Domain In tdc.DomainsList
Oh, and to be doing this you should almost certainly be logged in first by calling tdc.Login... rather than just connected to the server.
On a related note, the DomainsList property is deprecated. I think you can just loop through the List of ProjectDescriptor objects returned by GetAllVisibleProjectDescriptors since that covers all projects under all domains that the current logged on user has access to.
Edit: this is a complete solution based on the original question. Here's working tested code that will cycle through the domains/projects that the provided user has access to. This assumes you have the QC/ALM Connectivity add-in installed (required).
If you are running this piece of VBScript on a 64 bit machine you need to run it using the 32bit version of wscript.exe: C:\Windows\SysWOW64\wscript.exe "c:\somewhere\myscript.vbs"
msgbox "Creating connection object"
Dim tdc
Set tdc = CreateObject("TDApiOle80.TDConnection")
msgbox "Connecting to QC/ALM"
tdc.InitConnectionEx "http://<yourServer>/qcbin/"
msgbox "Logging in"
tdc.Login "<username>", "<password>"
Dim projDesc
msgbox "Getting project descriptors"
Set projectDescriptors = tdc.GetAllVisibleProjectDescriptors
For Each desc In projectDescriptors
msgbox desc.DomainName & "\" & desc.Name
Next
msgbox "Logging out"
tdc.Logout
msgbox "Disconnecting"
tdc.Disconnect
msgbox "Releasing connection"
tdc.ReleaseConnection
Edit 2:
If you want to parse the resulting XML from sa.GetAllDomains into a list of ALL domain\project items on the server you can do this (This is VBScript since the original question & tag still mention it, and has been tested):
Set objDoc = CreateObject("MSXML.DOMDocument")
objDoc.Load "C:\yourXmlFile.xml"
Set objRoot = objDoc.documentElement
For Each domain in objRoot.selectNodes("TDXItem")
For Each project in domain.selectNodes("PROJECTS_LIST/TDXItem")
msgbox domain.selectSingleNode("DOMAIN_NAME").text & "\" & project.selectSingleNode("PROJECT_NAME").text
Next
Next

Resources