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

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