Word VBA: Find Replace: Change URL format in text selection

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Word VBA: Find Replace: Change URL format in text selection

Post by Doc.AElstein »

Change like https://imgur.com/kix3xWe to https://i.imgur.com/kix3xWe.jpg
Hi
I need some help with Word VBA to replace/ change a lot of links in Word texts. ( The links are to a cloud image place, and they stopped working, but I found a workaround that makes them work. This workaround involves changing slightly the link format )
I expect I need to do something with those wild things, but for some reason my brain seems to be allergic to those and cant get my head around the syntax, or I can’t find a clear blog on it with lots of good examples to help me get the hang of using them.. ….
_._______________

So what I want to be able to do is:- I will select some text in a word document, then run the macro that will replace any occurrences of URL text like this

https://imgur.com/kix3xWe

to this

https://i.imgur.com/kix3xWe.jpg

In other words the bit at the start ,

https://imgur.com/

is changed to

https://i.imgur.com/

and an extra

.jpg

Is added on the end

This bit, kix3xWe , can be 6 or 7 characters made up of normal letters or numbers. The letters can be upper case or lower case.


The macro below does the first bit. Can anyone help me do it all, either by modifying that macro , or a better macro?
Note: My separator is a semi colon ; ( I use German Office )

Thanks

Alan

Code: Select all

 Sub ImgurWorkaround()  '   To change in a Word doc selection, things like  https://imgur.com/kix3xwe  to  https://i.imgur.com/kix3xwe.jpg
Rem 1 Reset Selection stuff
    With Selection.Find
    .ClearFormatting: .Replacement.ClearFormatting: .Text = "": .Replacement.Text = "":  .Forward = True: .Wrap = wdFindAsk: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False '
    End With

Rem 2
    With Selection.Find                                                                                        ' This is the VBA code ( or very similar ) used by Excel when Using the Find Replace text Dialogue box. So this is an improved version of what a macro recording would give.
    .ClearFormatting: .Replacement.ClearFormatting                                                             ' Don't use formating, ? not sure this comes into the equation ??
    .Wrap = wdFindStop                                                                                         ' Tell Word not to continue past the end of the selection ( And therefore prevents also a display Alert asking )
    .MatchWildcards = False                                                                                    ' Don't use wildcards. The default anyway, but in this code is an important - if not set to false, then
    .Text = "https://imgur.com/"
    .Replacement.Text = "https://i.imgur.com/"
    .Execute Replace:=wdReplaceAll                                                                             ' Replace all within selection. This is the "OK" button!
    
    '  I expect something with Wild things might be needed here...
    
    End With


Rem 10 Reset Selection stuff
    With Selection.Find
    .ClearFormatting: .Replacement.ClearFormatting: .Text = "": .Replacement.Text = "":  .Forward = True: .Wrap = wdFindAsk: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False '
    End With
End Sub
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
HansV
Administrator
Posts: 74428
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Word VBA: Find Replace: Change URL format in text selection

Post by HansV »

Try this:

Code: Select all

 Sub ImgurWorkaround()
    Dim hyp As Hyperlink
    Dim s As String
    Application.ScreenUpdating = False
    For Each hyp In ActiveDocument.Hyperlinks
        s = hyp.Address
        If s Like "*imgur.com*" Then
            s = Replace(s, "imgur", "i.imgur") & ".jpg"
            hyp.Address = s
            hyp.TextToDisplay = s
        End If
    Next hyp
    Application.ScreenUpdating = True
End Sub
Regards,
Hans

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Word VBA: Find Replace: Change URL format in text selection

Post by Doc.AElstein »

Thanks Hans, that seems to work great. That’ll save me a lot of time doing annoying manual editing.

( I made some minor changes
_a) I had some text where I had already manually changed a few links, and the original macro was changing them again to give like https://i.i.imgur.com/gFIEPFl.jpg.jpg
A simple change to the thing it is Like looking for sorted that out
_b) It seems to work also on the Selection . So I am doing it that way for now, bit by bit. That is not so efficient, but then I can see what its doing , which for now I prefer. )

Thanks again
Alan

Code: Select all

Sub ImgurWorkaroundHans2() '    https://eileenslounge.com/viewtopic.php?p=276315#p276315
Dim Hipp As Hyperlink
Dim Es As String
    For Each Hipp In Selection.Hyperlinks
     Let Es = Hipp.Address
        If Es Like "*/imgur.com*" Then
         Let Es = Replace(Es, "/imgur", "/i.imgur") & ".jpg"
         Let Hipp.Address = Es: Hipp.TextToDisplay = Es
        Else
        End If
    Next Hipp
End Sub
































 Sub ImgurWorkaroundHans1()   '   https://eileenslounge.com/viewtopic.php?p=276311#p276311
    Dim hyp As Hyperlink
    Dim s As String
    Application.ScreenUpdating = False
    For Each hyp In ActiveDocument.Hyperlinks
        s = hyp.Address
        If s Like "*imgur.com*" Then
            s = Replace(s, "imgur", "i.imgur") & ".jpg"
            hyp.Address = s
            hyp.TextToDisplay = s
        End If
    Next hyp
    Application.ScreenUpdating = True
End Sub
Last edited by Doc.AElstein on 21 Oct 2020, 09:20, edited 1 time in total.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
HansV
Administrator
Posts: 74428
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Word VBA: Find Replace: Change URL format in text selection

Post by HansV »

You should either use hyp or Hipp consistently, not a mixture of both.
Regards,
Hans

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Word VBA: Find Replace: Change URL format in text selection

Post by Doc.AElstein »

Thnx, it was a typo / oversight, I was editing as you posted.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Word VBA: Find Replace: Change URL format in text selection

Post by Doc.AElstein »

Hi,
I have hit a snag sometimes in this….

Sometimes in my Word document, my hyperlinks are not shown as hyperlinks. ( This can happen , for example , if I copy from a forum and the link text is embedded in those URL BB code tags )
URLCopiedFromForumInWordisBWNotURL.JPG
The working macros discussed here so far won’t work then. ( I expect that is because the URLs are not seen or “registered” as URLs )

I can make those URLs turn into URLs, and get the macros to work by adding manual a space after them, since then the URLs seem to change into URLs
ClickAfterURLMakeItAURL.JPG


I thought I might be able to automate that workaround, or do something similar by isolating the actual URL from the url BB code tags, like in the macro below, ( since when posting into a forum, the url still works with any amount of spaces )
But that still leaves the URLs as simple b/w text
IsolateURLSpaceMacroNoUse.JPG

Code: Select all

 Sub ImgurWorkaroundURLToURL()  '
Rem 1 Reset Selection stuff
    With Selection.Find
    .ClearFormatting: .Replacement.ClearFormatting: .Text = "": .Replacement.Text = "":  .Forward = True: .Wrap = wdFindAsk: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False '
    End With

Rem 2
    With Selection.Find                                                                                        ' This is the VBA code ( or very similar ) used by Excel when Using the Find Replace text Dialogue box. So this is an improved version of what a macro recording would give.
    .ClearFormatting: .Replacement.ClearFormatting                                                             ' Don't use formating, ? not sure this comes into the equation ??
    .Wrap = wdFindStop                                                                                         ' Tell Word not to continue past the end of the selection ( And therefore prevents also a display Alert asking )
    .MatchWildcards = False                                                                                    ' Don't use wildcards. The default anyway, but in this code is an important - if not set to false, then
    .Text = "[url]"
    .Replacement.Text = "[url] "
    .Execute Replace:=wdReplaceAll                                                                             ' Replace all within selection. This is the "OK" button!
    .Text = "[/url]"
    .Replacement.Text = " [/url]"
    .Execute Replace:=wdReplaceAll                                                                             ' Replace all within selection. This is the "OK" button!
    End With


Rem 10 Reset Selection stuff
    With Selection.Find
    .ClearFormatting: .Replacement.ClearFormatting: .Text = "": .Replacement.Text = "":  .Forward = True: .Wrap = wdFindAsk: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False '
    End With
End Sub
Can anyone suggest a way to get over this problem? One way I guess would be to do the original Wild way macro, but I still haven’t figured that one yet.

Thanks
Alan
You do not have the required permissions to view the files attached to this post.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Word VBA: Find Replace: Change URL format in text selection

Post by Doc.AElstein »

I have almost got a solution using the wild things in my first original macro , just as I was about to give up with those crazy wild thing syntaxes, ….

The macro below has two main bits.
The first, at '2a) , is the non wild bit which I had already figured out

Code: Select all

    '2a)
    .MatchWildcards = False
    .Text = "https://imgur.com/"
    .Replacement.Text = "https://i.imgur.com/"
    .Execute Replace:=wdReplaceAll                                                                             ' Replace all within selection. This is the "OK" button!
The wild bit in '2b) has taken me a couple of days of trial and error, as I can’t find any decent clear documentation on this wild stuff

Code: Select all

    '2b)
    .MatchWildcards = True                                                                                     '  use wildcards. The default anyway,  if set to false, then it will treat wild cards as simple text
    .Text = "imgur.com/[0-9A-z]{6;7}"       ' Note , for English Office -    "imgur.com/[0-9A-z]{6,7}"
    .Replacement.Text = "^&.jpg"
    .Execute Replace:=wdReplaceAll
What it seems to be doing is
Its looking for “imgur.com/” followed by 6-7 characters which can be a-z or A-Z or 0-9
What the wild bit , [0-9A-z]{6;7} , seems to be doing is
the bit in [ ] , is what I am looking for , and one of the syntaxes in there available is 0-9A-z which means characters which can be a-z or A-Z or 0-9
and the bit in { } is the number of those characters. The syntax 6;7 says look for 6 – 7 characters. ( And note, I need a semicolon in my German Office ; but more usually in English Excel you would need a comer , So in English Office it would be [0-9A-z]{6,7} )

Then this bit , ^& , represents that actual found text. So that has the extra .jpg added to it


So far almost so good

The problem I still have with this solution is that if I already had any corrected URL strings, the running this macro will add another .jpg on it
So I would have in such a case like
https://i.imgur.com/QMln86E.jpg.jpg

I don’t want that extra .jpg

So still looking to get this solution better….

Code: Select all

 '  https://eileenslounge.com/viewtopic.php?p=276668#p276668
Sub ImgurWorkaround()  '   To change in a Word doc selection, things like  https://imgur.com/kix3xwe  to  https://i.imgur.com/kix3xwe.jpg
Rem 1 Reset Selection stuff
    With Selection.Find
    .ClearFormatting: .Replacement.ClearFormatting: .Text = "": .Replacement.Text = "":  .Forward = True: .Wrap = wdFindAsk: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False '
    End With

Rem 2
    With Selection.Find                                                                                        ' This is the VBA code ( or very similar ) used by Excel when Using the Find Replace text Dialogue box. So this is an improved version of what a macro recording would give.
    .ClearFormatting: .Replacement.ClearFormatting                                                             ' Don't use formating, ? not sure this comes into the equation ??
    .Wrap = wdFindStop                                                                                         ' Tell Word not to continue past the end of the selection ( And therefore prevents also a display Alert asking )
    '2a)
    .MatchWildcards = False
    .Text = "https://imgur.com/"
    .Replacement.Text = "https://i.imgur.com/"
    .Execute Replace:=wdReplaceAll                                                                             ' Replace all within selection. This is the "OK" button!
    '2b)
    .MatchWildcards = True                                                                                     '  use wildcards. The default anyway,  if set to false, then it will treat wild cards as simple text
    .Text = "imgur.com/[0-9A-z]{6;7}"
    .Replacement.Text = "^&.jpg"
    .Execute Replace:=wdReplaceAll
    End With


Rem 10 Reset Selection stuff
    With Selection.Find
    .ClearFormatting: .Replacement.ClearFormatting: .Text = "": .Replacement.Text = "":  .Forward = True: .Wrap = wdFindAsk: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False '
    End With
End Sub 
Last edited by Doc.AElstein on 29 Oct 2020, 18:00, edited 3 times in total.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Word VBA: Find Replace: Change URL format in text selection

Post by Doc.AElstein »

I think this solution will do for me for now, although I expect there is a better way to do it….
I added an extra section to get rid of any double “.jpg” bits

Code: Select all

    '2c) remove any ".jpg.jpg"
    .MatchWildcards = False
    .Text = ".jpg.jpg"
    .Replacement.Text = ".jpg"
    .Execute Replace:=wdReplaceAll                                                                             ' Replace all within selection. This is the "OK" button!

Code: Select all

'  https://eileenslounge.com/viewtopic.php?p=276673#p276673             https://eileenslounge.com/viewtopic.php?p=276668#p276668
Sub ImgurWorkaround()  '   To change in a Word doc selection, things like  https://imgur.com/kix3xwe  to  https://i.imgur.com/kix3xwe.jpg
Rem 1 Reset Selection stuff
    With Selection.Find
    .ClearFormatting: .Replacement.ClearFormatting: .Text = "": .Replacement.Text = "":  .Forward = True: .Wrap = wdFindAsk: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False '
    End With

Rem 2
    With Selection.Find                                                                                        ' This is the VBA code ( or very similar ) used by Excel when Using the Find Replace text Dialogue box. So this is an improved version of what a macro recording would give.
    .ClearFormatting: .Replacement.ClearFormatting                                                             ' Don't use formating, ? not sure this comes into the equation ??
    .Wrap = wdFindStop                                                                                         ' Tell Word not to continue past the end of the selection ( And therefore prevents also a display Alert asking )
    '2a)  change  https://imgur.com/  to  https://i.imgur.com/
    .MatchWildcards = False
    .Text = "https://imgur.com/"
    .Replacement.Text = "https://i.imgur.com/"
    .Execute Replace:=wdReplaceAll                                                                             ' Replace all within selection. This is the "OK" button!
    '2b)  I need to add a  .jpg   on to the end of the full URL which typically is   like   https://i.imgur.com/hdf67Mf
    .MatchWildcards = True                                                                                     '  use wildcards. The default anyway,  if set to false, then it will treat wild cards as simple text
    .Text = "i.imgur.com/[0-9A-z]{6;7}"            '  the bit in [ ] , is what I am looking for , and one of the syntaxes in there available is 0-9A-z which means characters which can be a-z or A-Z or 0-9   and the bit in { } is the number of those characters. The syntax 6;7 says look for 6 – 7 characters. ( And note, I need a semicolon in my German Office ; but more usually in English Excel you would need a comer , So in English Office it would be [0-9A-z]{6, 7} )    _....  Then this bit , ^& , represents that actual found text. So that has the extra .jpg added to it
    .Replacement.Text = "^&.jpg"                 '  _....  Then this bit , ^& , represents that actual found text. So that has the extra .jpg added to it
    .Execute Replace:=wdReplaceAll
    '2c) remove any ".jpg.jpg"
    .MatchWildcards = False
    .Text = ".jpg.jpg"
    .Replacement.Text = ".jpg"
    .Execute Replace:=wdReplaceAll                                                                             ' Replace all within selection. This is the "OK" button!
    
    End With


Rem 10 Reset Selection stuff
    With Selection.Find
    .ClearFormatting: .Replacement.ClearFormatting: .Text = "": .Replacement.Text = "":  .Forward = True: .Wrap = wdFindAsk: .Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchKashida = False: .MatchDiacritics = False: .MatchAlefHamza = False: .MatchControl = False: .MatchWildcards = False: .MatchSoundsLike = False: .MatchAllWordForms = False '
    End With
End Sub








' Ref
' http://www.eileenslounge.com/viewtopic.php?p=175712#p175712
'   http://www.excelforum.com/the-water-cooler/1103850-extra-space-or-spaces-in-text-in-forum-post-bb-code-for-extra-space-2.html

( and by the way, after two days of getting no where on the internet , I finally got most of the way to a solution from a macro Hans did for me a few years ago, which stupidly I had forgotten about http://www.eileenslounge.com/viewtopic. ... 12#p175712 )
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also