Search for 2 words in oReceivedMail.Subject with InStr

[bmdo]

Hi,

I managed to get InStr working - it has to serach for a word in the mail subject.
Now my colleague wants it to serach for 2 words and I cannot find the right syntax :(

Hope someone can help me out :friends:

I need it to look for both arrival confirmation and delivery confirmation, if it is either one of them it has to be changed to Payment reminder - past due invoice

Thanks - have a nice day



If InStr(1, LCase(oReceivedMail.Subject), "arrival confirmation", vbTextCompare) <> 0 Then oNewMail.Subject = "Payment reminder - past due invoice: "

[gmayor]

If InStr(1, LCase(oReceivedMail.Subject), "arrival confirmation") > 0 Or _
InStr(1, LCase(oReceivedMail.Subject), "delivery confirmation") > 0 Then
oNewMail.Subject = "Payment reminder - past due invoice: "
End If

[bmdo]

Hi gmayor

thanks for input :)
But it doesn't work - it changes from arrival to Payment, but from delivery to nothing/blank subject :(

[gmayor]

It will work if the test finds the exact texts in the Subject text of the message oReceivedMail.

Select a message and test it with



Sub Macro1()
Dim oReceivedMail As MailItem
Dim oNewMail As MailItem
Set oReceivedMail = ActiveExplorer.Selection.Item(1)
Set oNewMail = CreateItem(olMailItem)
If InStr(1, LCase(oReceivedMail.Subject), "arrival confirmation") > 0 Or _
InStr(1, LCase(oReceivedMail.Subject), "delivery confirmation") > 0 Then
oNewMail.Subject = "Payment reminder - past due invoice: "
oNewMail.Display
End If
End Sub

[bmdo]

Ok, maybe it would be easier if you saw the entire code :)
I am a newbie and not sure how I can implement the example code into mine.


Private Sub btnSubmit_Click()
Dim oFSO, oFS As Object
Dim sTmp, sOrderRef, sText, sTemplate As String
Dim i As Integer


If lbOrderRef.ListCount = 0 Then
' no order refs added yet throw error and do nothing else!
Call Error.doThrowError("ReminderForm", doERR_REMINDER_ListEmptyNoAttachments)
Else
' order refs have been added - and we assume they exist.
' if they dont exist that is handled in the tbOrderRef_KeyDown event call
If doPing = 0 Then
' ping and then go go go


'If InStr(1, LCase(oReceivedMail.Subject), "arrival confirmation", vbTextCompare) <> 0 Then oNewMail.Subject = "Payment reminder - past due invoice: "
'oNewMail.Subject = Replace(oNewMail.Subject, "RE: ", "", , , vbTextCompare)
'oNewMail.Subject = Replace(oNewMail.Subject, "FW: ", "", , , vbTextCompare)
If InStr(1, LCase(oReceivedMail.Subject), "arrival confirmation") > 0 Or _
InStr(1, LCase(oReceivedMail.Subject), "delivery confirmation") > 0 Then oNewMail.Subject = "Payment reminder - past due invoice: "
End If

End If


' Add attachment from
sTmp = ""
For i = 0 To lbOrderRef.ListCount - 1
Call oNewMail.Attachments.Add(Settings.GetSettingValue("ReminderForm", "PendingOrdersPath") + lbOrderRef.List(i))
sOrderRef = Left(lbOrderRef.List(i), InStr(1, lbOrderRef.List(i), " ", vbTextCompare) - 1)

' make sure there are no douplicate orderefs
If sTmp <> sOrderRef Then
oNewMail.Subject = oNewMail.Subject '+ ", " + sOrderRef
sTmp = sOrderRef
End If
Next i

' choose template file
sTemplate = Settings.GetSettingValue("ReminderForm", "TemplateFileRem")


' Remove @Danoffice.com from To and CC

For i = 1 To oReceivedMail.Recipients.Count
If InStr(1, oReceivedMail.To, oReceivedMail.Recipients.Item(i).AddressEntry, vbTextCompare) Then oNewMail.To = oNewMail.To + ";" + oReceivedMail.Recipients.Item(i).Address
If InStr(1, oReceivedMail.CC, oReceivedMail.Recipients.Item(i).AddressEntry, vbTextCompare) Then oNewMail.CC = oNewMail.CC + ";" + oReceivedMail.Recipients.Item(i).Address
Next
Call SharedFunctionality.doRemoveRecipient(oNewMail, "danoffice")


Set oFSO = CreateObject("Scripting.FileSystemObject")


' Path to document you want to parse
Set oFS = oFSO.OpenTextFile(Environ$("APPDATA") + Settings.GetSettingValue("Base", "RootPath") + sTemplate + ".html")

'Copy the open document
Do Until oFS.AtEndOfStream
sText = oFS.ReadAll()
Loop


oNewMail.BodyFormat = olFormatHTML

oNewMail.Display

' capture signature AFTER the mail has been displayed, otherwise the signature will not have been rendered and will disappear.
oNewMail.HTMLBody = "<body font-size=11pt>" & sText & oNewMail.HTMLBody & oReceivedMail.HTMLBody & "</body>"

' exit gracefully and hide form
Me.Hide
isShowing = False
'Else
'Call Error.doThrowError("ReminderForm", Error.doUnableToPing)
'End If
'End If

Set oFSO = Nothing
Set oFS = Nothing
Set oNewMail = Nothing
Set oReceivedMail = Nothing
End Sub

Private Sub lbOrderRef_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
Dim i As Integer

If lbOrderRef.ListCount > 0 Then
i = 0
Do While Not lbOrderRef.Selected(i) And i <= lbOrderRef.ListCount
i = i + 1
Loop

tbOrderRef.Value = Left(lbOrderRef.List(i), InStr(1, lbOrderRef.List(i), " ", vbTextCompare) - 1)
lbOrderRef.RemoveItem (i)
End If
End Sub

Private Sub tbOrderRef_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim sPath, sFilter, sInvoice, sPackingList As String
Dim oFSO As Object

Set oFSO = CreateObject("Scripting.FileSystemObject")

If KeyCode = vbKeyReturn And tbOrderRef.Value <> "" Then
' we are ready to add to the list
' though first check if the files exist

'If doPing = 0 Then
' we are on DO LAN so go with the file checking

If oFSO.fileExists(Settings.GetSettingValue("ReminderForm", "PendingOrdersPath") + tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "PackListPostFix") + ".pdf") Then
If SharedFunctionality.doGetItemPos(lbOrderRef, tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "PackListPostFix") + ".pdf") = -1 Then Call lbOrderRef.AddItem(tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "PackListPostFix") + ".pdf")
End If
' Incase the orderref documents have been split in 2
If oFSO.fileExists(Settings.GetSettingValue("ReminderForm", "PendingOrdersPath") + tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "PackListPostFix") + " 2.pdf") Then
If SharedFunctionality.doGetItemPos(lbOrderRef, tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "PackListPostFix") + " 2.pdf") = -1 Then Call lbOrderRef.AddItem(tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "PackListPostFix") + " 2.pdf")
End If

If oFSO.fileExists(Settings.GetSettingValue("ReminderForm", "PendingOrdersPath") + tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "InvoicePostFix") + ".pdf") Then
If SharedFunctionality.doGetItemPos(lbOrderRef, tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "InvoicePostFix") + ".pdf") = -1 Then Call lbOrderRef.AddItem(tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "InvoicePostFix") + ".pdf")
End If
If oFSO.fileExists(Settings.GetSettingValue("ReminderForm", "PendingOrdersPath") + tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "InvoicePostFix") + " 2.pdf") Then
If SharedFunctionality.doGetItemPos(lbOrderRef, tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "InvoicePostFix") + " 2.pdf") = -1 Then Call lbOrderRef.AddItem(tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "InvoicePostFix") + " 2.pdf")
End If

If oFSO.fileExists(Settings.GetSettingValue("ReminderForm", "PendingOrdersPath") + tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "AWBPostFix") + ".pdf") Then
If SharedFunctionality.doGetItemPos(lbOrderRef, tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "AWBPostFix") + ".pdf") = -1 Then Call lbOrderRef.AddItem(tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "AWBPostFix") + ".pdf")
End If
If oFSO.fileExists(Settings.GetSettingValue("ReminderForm", "PendingOrdersPath") + tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "AWBPostFix") + " 2.pdf") Then
If SharedFunctionality.doGetItemPos(tbOrderRef, tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "AWBPostFix") + " 2.pdf") = -1 Then Call lbOrderRef.AddItem(tbOrderRef.Value + Settings.GetSettingValue("ReminderForm", "AWBPostFix") + " 2.pdf")
End If

tbOrderRef.Value = ""
'End If
End If

If KeyCode = 13 Then
' if enter key pressed then stay in textbox
KeyCode = 0
End If

Set oFSO = Nothing
End Sub

[gmayor]

The code you have posted is only part of the picture and serves to complicate matters even more. For example the macro does not indicate what oReceivedMail is nor what oNewMail is. Clearly they relate to a pair of messages, but the macro code you have shown has no idea what they refer to. There are also variables that have not been declared.
The code sequence I originally posted should be inserted where the message oNewMail is created.

[bmdo]

I see your point. We have 5 Modules and 9 Forms - as I said I am a newbie and not fully up to speed with either VBA in general nor our code :)
Think it would be to time consuming for you if I sent you the entire .OTM file ... so I will try to contact the guy who made our macros and see if he can solve this with me.
Thanks for trying