Strip characters from front and end of hyperlink 1

[thomasks]

I have some code that creates a task from an email when it is received. In the email is a hyperlink, but when the hyperlink is copied to the task there are extra characters being added to the front and end of the hyperlink itself. How can I strip these out programmatically? I need to strip out (delete) the characters that appear before and after the double quotes (and including the double quotes themselves). Here is an example of how the hyperlink gets copied into the task:
HYPERLINK "

http://webap.amcs.tld/ccqr/pqr_form...eqid=5a35a508-d241-445f-987d-4403b41531f4"PQR

And here is an example of how it should look:

http://webap.amcs.tld/ccqr/pqr_form.aspx?action=edit&projseqid=5a35a508-d241-445f-987d-4403b41531f4

Thanks for the help.

 

[PHV]

A starting point:
strHL = "HYPERLINK ""

http://webap.amcs.tld/ccqr/pqr_form...id=5a35a508-d241-445f-987d-4403b41531f4""PQR"

MsgBox Split(strHL, """")(1)

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[stevexff]

Alternative solution:

Sub reggie()

   Dim text As String
   text = "HYPERLINK ""[URL unfurl="true"]http://webap.amcs.tld/ccqr/pqr_form.aspx?action=edit&projseqid=5a35a508-d241-445f-987d-4403b41531f4""PQR"[/URL]
   Dim re As VBScript_RegExp_55.RegExp
   Set re = New VBScript_RegExp_55.RegExp
   re.Pattern = """([^""]+)"
   Set mymatches = re.Execute(text)
   Debug.Print mymatches(0).SubMatches(0)
   
End Sub

you could amend the sub to a function to return the stripped-out string...

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[thomasks]

Ok, this is a good start, but the string will be different each time. Here is the code I run in "This outlook session":

Private Sub Application_NewMail()
 
   Dim oNameSpace                  As NameSpace
   Dim oFolderInbox                As MAPIFolder
   Dim oMailItem                   As MailItem
 
   Set oNameSpace = Application.GetNamespace("MAPI")
   Set oFolderInbox = oNameSpace.GetDefaultFolder(olFolderInbox)
 
   oFolderInbox.Items.Sort "Received", False
   Set oMailItem = oFolderInbox.Items.GetFirst
 
   If InStr(LCase(oMailItem.Subject), "pqr") > 0 Or _
      InStr(LCase(oMailItem.Subject), "rfq") > 0 Or _
      InStr(LCase(oMailItem.Subject), "ccqr") > 0 And _
      InStr(LCase(oMailItem.Body), "estimator is kirk thomas") > 0 Then
      With oMailItem
         NewTask .SenderName, .Subject, .Body, .Attachments
      End With
 
      oMailItem.Delete
   End If
 
   Set oMailItem = Nothing
   Set oFolderInbox = Nothing
   Set oNameSpace = Nothing
 
End Sub

And here is the code from the module:

Sub NewTask(ByVal sSenderName As String, _
            ByVal sSubject As String, _
            ByVal sBody As String, _
            ByRef oAttachments As Attachments)
 
   Dim oTaskitem                   As TaskItem
   Dim oAttachment                 As Attachment
   Dim dToday                      As Date
 
   Set oTaskitem = Application.CreateItem(olTaskItem)
   dToday = Date
 
   With oTaskitem
      .ContactNames = sSenderName
      .Subject = sSubject
      .StartDate = dToday
      .DueDate = dToday + 2
 
      If oAttachments.Count > 0 Then
         .Body = sBody & vbLf & vbLf & "Attachments: " & vbLf & vbLf
         CopyAttachments oAttachments, .Attachments
      Else
         .Body = sBody
      End If
        .Display
        
'      .Close olSave
   End With
 
   Set oTaskitem = Nothing
   Set oAttachment = Nothing

End Sub

Sub CopyAttachments(ByRef oSource As Attachments, _
                    ByRef oTarget As Attachments)
 
   Dim oAttachment                 As Attachment
   Dim oFileSystemObject           As Object
   Dim oTemporaryFolder            As Object
   Dim sPath                       As String
   Dim sFile                       As String
 
   Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
   Set oTemporaryFolder = oFileSystemObject.GetSpecialFolder(2)
 
   sPath = oTemporaryFolder.Path & "\"
   For Each oAttachment In oSource
      sFile = sPath & oAttachment.FileName
      oAttachment.SaveAsFile sFile
      oTarget.Add sFile, , , oAttachment.DisplayName
      oFileSystemObject.DeleteFile sFile
   Next
 
   Set oAttachment = Nothing
   Set oTemporaryFolder = Nothing
   Set oFileSystemObject = Nothing
 
End Sub

So how should I edit what I have to strip out the unwanted characters from the hyperlink?
Also is there a way to NOT run this code if another email comes in concerning the same project, and the task has already been created?
Thanks

 

[stevexff]

Both suggested solutions assume that you have

blahblah[red]"[/red][i]someStringIWantSurroundedByQuotes[/i][red]"[/red]blahblah

What else do you need to edit?

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[thomasks]

So how should I edit what I have to strip out the unwanted characters from the hyperlink?
Also is there a way to NOT run this code if another email comes in concerning the same project, and the task has already been created?"

I don't understand how to edit the code I already have to add the "solution" since the string will always be different each time, and I cannot enter the literal string.
As well as having the code only run the first time the email comes in and not create redundant tasks for the same project.

 

[stevexff]

Function stripLink(text As String) As String

   Dim re As VBScript_RegExp_55.RegExp
   Set re = New VBScript_RegExp_55.RegExp
   re.Pattern = """([^""]+)"
   Set mymatches = re.Execute(text)
   stripLink = mymatches(0).SubMatches(0)
   
End Function

then, where you have your string in the code that you want to clean up

   Dim text As String
   text = "HYPERLINK ""[URL unfurl="true"]http://webap.amcs.tld/ccqr/pqr_form.aspx?action=edit&projseqid=5a35a508-d241-445f-987d-4403b41531f4""PQR"[/URL]
   Dim stripped As String
   stripped = stripLink(text)
   Debug.Print stripped

As for the other thing, I assume that you just get the Items collection for the Tasks MAPI folder, and either iterate through it or use the Find method to see if the task you want is already there?

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[thomasks]

OK, I added the code into my code (in the module, not the this outlook session). Then I was getting a user defined data type not defined error. ( at the Dim re As VBScript_RegExp_55.RegExp)
I have commented out the code that you gave me so that outlook would continue to work until I figure out what is wrong. Here is the code as I had it, maybe I have it in the wrong place or something.

Option Explicit
Option Base 1
'Function stripLink(text As String) As String
'
'   Dim re As VBScript_RegExp_55.RegExp
'   Set re = New VBScript_RegExp_55.RegExp
'   re.Pattern = """([^""]+)"
'   Set mymatches = re.Execute(text)
'   stripLink = mymatches(0).SubMatches(0)
'
'End Function
 

Sub NewTask(ByVal sSenderName As String, _
            ByVal sSubject As String, _
            ByVal sBody As String, _
            ByRef oAttachments As Attachments)
 
   Dim oTaskitem                   As TaskItem
   Dim oAttachment                 As Attachment
   Dim dToday                      As Date
'   Dim text                        As String
'   text = sBody
'   Dim stripped As String
'   stripped = stripLink(text)
'   Debug.Print stripped

   Set oTaskitem = Application.CreateItem(olTaskItem)
   dToday = Date
 
   With oTaskitem
      .ContactNames = sSenderName
      .Subject = sSubject
      .StartDate = dToday
      .DueDate = dToday + 2
 
      If oAttachments.Count > 0 Then
         .Body = sBody & vbLf & vbLf & "Attachments: " & vbLf & vbLf
'         .Body = stripped & vbLf & vbLf & "Attachments: " & vbLf & vbLf
         CopyAttachments oAttachments, .Attachments
      Else
'         .Body = sbody
'         .Body = stripped
      End If
'        .Display
        
      .Close olSave
   End With
 
   Set oTaskitem = Nothing
   Set oAttachment = Nothing

End Sub
 
Sub CopyAttachments(ByRef oSource As Attachments, _
                    ByRef oTarget As Attachments)
 
   Dim oAttachment                 As Attachment
   Dim oFileSystemObject           As Object
   Dim oTemporaryFolder            As Object
   Dim sPath                       As String
   Dim sFile                       As String
 
   Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
   Set oTemporaryFolder = oFileSystemObject.GetSpecialFolder(2)
 
   sPath = oTemporaryFolder.Path & "\"
   For Each oAttachment In oSource
      sFile = sPath & oAttachment.FileName
      oAttachment.SaveAsFile sFile
      oTarget.Add sFile, , , oAttachment.DisplayName
      oFileSystemObject.DeleteFile sFile
   Next
 
   Set oAttachment = Nothing
   Set oTemporaryFolder = Nothing
   Set oFileSystemObject = Nothing
 
End Sub

 

[PHV]

Function stripLink(text As String) As String
stripLink = Split(text, """")(1)
End Function

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[thomasks]

Thanks that seems to strip out the link just fine. Now the only problem is that I still have the original faulty link inserting into the task. How can I delete that one and only have the stripped one insert into the body of the task?
Here is the code:

Function stripLink(text As String) As String
   stripLink = Split(text, """")(1)
End Function

 

Sub NewTask(ByVal sSenderName As String, _
            ByVal sSubject As String, _
            ByVal sBody As String, _
            ByRef oAttachments As Attachments)
 
   Dim oTaskitem                   As TaskItem
   Dim oAttachment                 As Attachment
   Dim dToday                      As Date
   Dim text                        As String
   text = sBody
   Dim stripped As String
   stripped = stripLink(text)
'   Debug.Print stripped

   Set oTaskitem = Application.CreateItem(olTaskItem)
   dToday = Date
 
   With oTaskitem
      .ContactNames = sSenderName
      .Subject = sSubject
      .StartDate = dToday
      .DueDate = dToday + 2
 
      If oAttachments.Count > 0 Then
'         .Body = sBody & vbLf & vbLf & "Attachments: " & vbLf & vbLf
         .Body = sBody & stripped & vbLf & vbLf & "Attachments: " & vbLf & vbLf
         CopyAttachments oAttachments, .Attachments
      Else
'         .Body = sbody
         .Body = sBody & vbLf & vbLf & stripped
      End If
'        .Display
        
      .Close olSave
   End With
 
   Set oTaskitem = Nothing
   Set oAttachment = Nothing

End Sub

 

[PHV]

Something like this ?

Function stripLink(text As String) As String
   stripLink = Split(text, """")(1)
End Function

Sub NewTask(ByVal sSenderName As String, _
            ByVal sSubject As String, _
            ByVal sBody As String, _
            ByRef oAttachments As Attachments)
 
   Dim oTaskitem                   As TaskItem
   Dim oAttachment                 As Attachment
   Dim dToday                      As Date

   Set oTaskitem = Application.CreateItem(olTaskItem)
   dToday = Date
   With oTaskitem
      .ContactNames = sSenderName
      .Subject = sSubject
      .StartDate = dToday
      .DueDate = dToday + 2
      .Body = stripLink(sBody) & vbLf & vbLf
      If oAttachments.Count > 0 Then
         .Body = .Body & "Attachments: " & vbLf & vbLf
         CopyAttachments oAttachments, .Attachments
      End If
'     .Display
      .Close olSave
   End With
   Set oTaskitem = Nothing
   Set oAttachment = Nothing
End Sub

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[stevexff]

You need to add a reference to MS VBScript Regex 5.5 to get the regex version to work.

I get the distinct impression were not helping you, but doing your job for you...

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[thomasks]

I appreciate the help. I am a total newbie on VBA and was trying to do it myself with the help of a book.
This is not my job, I am only doing it to improve my personal in box in outlook so that it creates tasks for ME.
I just didn't understand what needed to be done and thought I should ask those that do.
I apologize for the inconvenience.

 

[stevexff]

Sorry thomasks. I wasn't having a go at you. If you are learning VBA from scratch then that's very commendable, although you have picked quite a complex task for a first program...

If you need any more help, post back...

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[thomasks]

Thanks Steve,
Santa has brought me the "Mastering VBA" second edition by Guy Hart-Davis.
This is what I am using to try and teach myself VBA. I have no prior experience, but have dabbled in VB a little and will learn this as well. I am very determined.
The probelem that I have with this task is that I now can strip out the proper link and insert it into the body of the "task". But I still get the bad link with the HYPERLINK" and the unknown link here "PQR (or RFQ or CCQR depending on which type of quote was sent in the email. The letters at the end of the link depend on what type it is).
So now I want to be able to select this text in the body of the task and delete it so that all that is left is the "good" link. I have included the code that I have in outlook now and it works. I just don't have any idea on how to add in the part to find and delete this one string.
Thanks for your patience.

Kirk

 

[thomasks]

OK, I got it!
Here is the code that made it work.

Sub NewTask(ByVal sSenderName As String, _
            ByVal sSubject As String, _
            ByVal sBody As String, _
            ByRef oAttachments As Attachments)
 
   Dim oTaskitem                   As TaskItem
   Dim oAttachment                 As Attachment
   Dim dToday                      As Date
   Dim LinkString                 As String
    
   LinkString = stripLink(sBody)
   Set oTaskitem = Application.CreateItem(olTaskItem)
   dToday = Date
   With oTaskitem
      .ContactNames = sSenderName
      .Subject = sSubject
      .StartDate = dToday
      .DueDate = dToday + 2
      .Body = Left(sBody, InStr(1, sBody, "HYPERLINK") - 1) & LinkString
      If oAttachments.Count > 0 Then
         .Body = .Body & "Attachments: " & vbLf & vbLf
         CopyAttachments oAttachments, .Attachments
      End If
      .Close olSave
   End With
   Set oTaskitem = Nothing
   Set oAttachment = Nothing
End Sub

Thanks for all the helpful suggestions, and patience. This site is great for learning from the best.

As you can see I was able to use the "Left" and "Instr" to find the body of the task and strip out the bad link from it. Then I used the function that already had the link stripped out and stored in a variable to replace with the good link.

 

[stevexff]

Considerable improvement. Note how much smaller the final version of NewTask() is compared with the original, and it even works properly too!

Have a star...

Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]