Click here to Skip to main content
Rate this: bad
good
Please Sign up or sign in to vote.
See more: VB VBScript Outlook VBA Word
I have written a code which replaces the text of certain format into a hyperlink. This code is invoked by a rule during an Incoming email.
 
Incoming email -> copy the email to word editor -> make necessary changes -> copy from word editor to outlook mail item(replaced hyperlinks gets lost in mail item, while newly added text reamins intact)
 
My code is here for your refernce..

Sub IncomingHyperlink(MyMail As MailItem)
  Dim strID As String
  Dim Body As String
  Dim objMail As Outlook.MailItem
  Dim myObject As Object
  Dim myDoc As Word.Document
  Dim mySelection As Word.Selection
  
  strID = MyMail.EntryID
  Set objMail = Application.Session.GetItemFromID(strID)
  
  'Creates word application
  Set objWord = CreateObject("Word.Application")
  objWord.Visible = True
  Set objDoc = objWord.Documents.Add()
  Set objSelection = objWord.Selection
  'Copies contents of email into word document
  objSelection.TypeText "GOOD" & objMail.HTMLBody
  
  With objSelection.Find
   .ClearFormatting
   .Text = "ASA[0-9][0-9][0-9][0-9][a-z][a-z]"
   .Forward = True
   .Wrap = wdFindAsk
   .MatchWildcards = True
  End With
  
  objSelection.Find.Execute
  objSelection.Hyperlinks.Add Anchor:=objSelection.Range, _
  Address:="http://www.code.com/" & objSelection.Text, _
  TextToDisplay:=objSelection.Text
  
  'Copies contents to email item from word document
  objMail.HTMLBody = objDoc.Range(0, objDoc.Range.End)
  objMail.Save
  Set objMail = Nothing
 End Sub
Also, this code replaces only the first occurrence of the needed text and does not replace others.
Please help solve these problems. Thank you...
I have tried out different options and still not able to get it work.
Posted 20-Jun-11 11:37am
Edited 20-Jun-11 11:38am
v2

1 solution

Rate this: bad
good
Please Sign up or sign in to vote.

Solution 1

You need to loop until Execute() is true.
Do while objSelection.Find.Execute()
    'code to make changes in text
Loop
  Permalink  

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

  Print Answers RSS
0 OriginalGriff 505
1 Maciej Los 309
2 BillWoodruff 174
3 /\jmot 160
4 Suraj Sahoo | Coding Passion 160
0 OriginalGriff 8,654
1 Sergey Alexandrovich Kryukov 7,407
2 DamithSL 5,639
3 Maciej Los 5,229
4 Manas Bhardwaj 4,986


Advertise | Privacy | Mobile
Web02 | 2.8.1411023.1 | Last Updated 22 Jun 2011
Copyright © CodeProject, 1999-2014
All Rights Reserved. Terms of Service
Layout: fixed | fluid

CodeProject, 503-250 Ferrand Drive Toronto Ontario, M3C 3G8 Canada +1 416-849-8900 x 100