Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Strip characters from front and end of hyperlink 1

Status
Not open for further replies.
thomasks

thomasks

Programmer
May 12, 2006
113
US
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 "And here is an example of how it should look:
Thanks for the help.
 
Sort by date Sort by votes
Alternative solution:
Code: 
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::perlDesignPatterns)[/small]
 
Upvote 0 Downvote
Ok, this is a good start, but the string will be different each time. Here is the code I run in "This outlook session":
Code: 
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:
Code: 
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
 
Upvote 0 Downvote
Both suggested solutions assume that you have
Code: 
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::perlDesignPatterns)[/small]
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
Code: 
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
Code: 
   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::perlDesignPatterns)[/small]
 
Upvote 0 Downvote
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.
Code: 
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
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
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:
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
 
Upvote 0 Downvote
Something like this ?
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

   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
 
Upvote 0 Downvote
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::perlDesignPatterns)[/small]
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
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...[smile]

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::perlDesignPatterns)[/small]
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
OK, I got it!
Here is the code that made it work.
Code: 
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.
 
Upvote 0 Downvote
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::perlDesignPatterns)[/small]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

aldi07
  • Locked
  • Question
update a front-end databases with a new release using vba
Replies
2
Views
372
aldi07
aldi07
Andrzejek
  • Locked
  • Question
Copy data between SQL and Oracle 1
Replies
8
Views
1K
remeng
remeng
remeng
  • Locked
  • Question
CTRL + BREAK from second macro button
Replies
5
Views
898
strongm
strongm
Andrzejek
  • Locked
  • Question
Hyperlinks in Word cut at #
Replies
2
Views
372
Andrzejek
Andrzejek
remeng
  • Locked
  • Question
Getting results from a dynamic dimension array
Replies
2
Views
668
Andrzejek
Andrzejek

Part and Inventory Search

Sponsor

Back
Top