Home Ask Login Register

Developers Planet

Your answer is one click away!

Ádám Bukovinszki February 2016

Delete or overwrite body text AFTER a given keyword

The purpose of my search is to create a script for Outlook, that:

  1. Removes a password field from the body of a selected inbox email
  2. & saves it to the hard-drive to a set folder for administrative purposes.

So basically every email contains a line like "password: xyz" I don't want to delete the constant part "password:", only the dynamic part after it. Either by deleting the whole line after the keyword, or by overwriting the dynamic part with a long enough string like "PW removed from this copy" or similar.

I could figure out how to search for a given text in mail body, and how to replace it, or how to insert text into a mail-body, BUT i couldn't find anywhere, how to modify (delete or over-wright) text AFTER the search term and not the search term itself.

My demo code is in this stage right now: (only allowing to replace already known text, but cannot reach to the unknown part with it) (( you can see that my code contains switched off lines like ".insertbefore"; I was experimenting with that approach a bit too just without success, so turned it off for now ))

Public Sub SaveMessageAsMsg()
    Dim oMail As Outlook.MailItem
    Dim objItem As Object
    Dim sPath, strFolderpath As String
    Dim dtDate As Date
    Dim sName As String
    Dim enviro As String
    Dim body As String

    enviro = CStr(Environ("USERPROFILE"))

    sPath = "D:\Demo\"

    For Each objItem In ActiveExplorer.Selection
        If objItem.MessageClass = "IPM.Note" Then
            Set oMail = objItem
            sName = oMail.Subject
            body = oMail.body
            body = Replace(body, "Password:", "Password: -Removed-")
            'objSel.InsertBefore strText
            oMail.body = body
            'Debug.Print sPath & sName
            oMail.SaveAs sPath & sName & ".msg", olMSG
         End If
    Next
End Sub

Answers


Ádám Bukovinszki February 2016

Ok Guys I found a workaround finally to my question, but i can barely beleive that there is no simpler method for this, so if anybody can come up with a more elegant solution, pls do so (Just to learn from it the right way)

Basically I used two searches to find the POSITIONS of the first known word and the next known word in the text , substracted them from eachother to get the number of characters in between them and finally pasted some string in between.

The benefit of this method at least is that it assures that i wont hurt the content of the next line, no matter how long overwritten unknown text was.

The key element in this solution was the MID statement.

Public Sub SaveMessageWithoutPW()
    Dim oMail As Outlook.MailItem
    Dim objItem As Object
    Dim sPath, strFolderpath As String
    Dim sName As String
    Dim enviro As String
    Dim body As String
    Dim TestPos As Integer
    Dim EndPos As Integer
    Dim PosL As Integer

    enviro = CStr(Environ("USERPROFILE"))

    sPath = "D:\Demo\"

    For Each objItem In ActiveExplorer.Selection
        If objItem.MessageClass = "IPM.Note" Then
            Set oMail = objItem
            sName = oMail.Subject
            body = oMail.body
            TestPos = InStr(body, "Password") + 9 '+9 for Password itself
            EndPos = InStr(body, "Send an email")
            PosL = (EndPos - TestPos) - 1 '-1 For the linebreak
            Mid(body, TestPos, PosL) = " ******************************"
            'PosL defines how many * to use at most, not to hurt other content
            oMail.body = body
            oMail.SaveAs sPath & sName & ".msg", olMSG
         End If
    Next
End Sub


niton February 2016

A method to "extract information from a message that contains structured text" is described here Parsing text from a message body.

The code would look something like this:

option explicit

Public Sub SaveMessageAsMsg()

    Dim objItem As Object
    Dim sPath As String
    Dim strFolderpath As String

    Dim sName As String
    Dim enviro As String

    Dim strPswd As String
    Dim strAll as String

    enviro = CStr(Environ("USERPROFILE"))

    sPath = "D:\Demo\"

    For Each objItem In ActiveExplorer.Selection

        If objItem.MessageClass = "IPM.Note" Then

            sName = objItem.Subject

            strPswd = ParseTextLinePair(objItem.body, "Password:")

            ' If strPswd is reliably unique in the message
            ' objItem.body = Replace(objItem.body, strPswd, "-Removed-")

            ' To be safe, carefully determine the exact label and text to replace,
            '   including the space, if any, after the colon
            strAll = "Password: " & strPswd
            Debug.Print strAll
            objItem.body = Replace(objItem.body, strAll, "Password: -Removed-")
            'Debug.Print sPath & sName
            objItem.SaveAs sPath & sName & ".msg", olMSG
         End If
    Next

End Sub

Function ParseTextLinePair(strSource As String, strLabel As String)
    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer
    Dim intLenLabel As Integer
    Dim strText As String

    ' locate the label in the source text
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)
        If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, _
                            intLocL 

Post Status

Asked in February 2016
Viewed 2,474 times
Voted 12
Answered 2 times

Search




Leave an answer


Quote of the day: live life