Some string text in Word Tests and Experiments
Not doing anything special here, not yet anyway. I just want a quick coding to
_ take a highlighted text in a word .doc , and
_ pick out any URL links, and
_ put those links in the clipboard in some convenient form to paste somewhere.
What have we got
A good start point is to check what a typical text containing the URLs is, in particular we need to look in a bit more detail to see what non obvious, so called “invisible” characters may be there.
This is the coding to run after selecting some text in a word .doc
Code:
Option Explicit
' https://www.excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=21221&viewfull=1#post21221 https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222&viewfull=1#post21222 String text in Word html.doc
Sub WhatsInIt()
Dim Str As String ' To hold the selected text in word
Let Str = Selection.Text
Call WatchaGotWord(Str)
End Sub
The function can be found here https://www.excelfox.com/forum/showt...1221#post21221
Here is an example of some text
https://i.postimg.cc/hQddkG8q/A-bit-...-word-text.jpg
I indicated there, areas to be looked at.
Here is a few results of what the coding shows me
Code:
"Hub" & "." & vbCr & vbCr & "The " & "$"
"sUQxO5CVyx4AaABAg" & vbCr & vbCr & vbCr & "1 of " & "4"
"https" & ":" & "/" & "/" & "www" & "." & "youtube" & "." & "com" & "/" & "watch" & "?" & "v" & "=" & "yVgLmj0aojI" & "&" & "lc" & "=" & "UgwWg8x2WxLSxxGsUP14AaABAg" & "." & "9k3ShckGnhv9k89LsaigoO 1" & vbCr
Conclusions of text content investigation
No big surprises. It seems that a new line is indicated by vbCr – That is occaisionally used instead of the more typical 2 characters , vbCr & vbLf.
A solution for a quick coding would be:
_ Replace any vbCr ( or any pair of vbCr & vbLf just incase that is used anywhere ) , with a space.
_ Do a VBA Split using spaces as the separator.
_ Go through each array element, take any looking like a link.
_ Put those links in the clipboard in a convenient way to paste out
This will do for now
Code:
Sub URLsToClipboard() ' https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222#post21222
Dim Str As String ' To hold the selected text in word
Let Str = Selection.Text
Let Str = Replace(Str, vbCr & vbLf, " ", 1, -1, vbBinaryCompare) ' Do this first before next line or else I might end up with vbLfs which may mess things up. For now I assume the vbLf on its own wont be used anywhere. It rarely is
Let Str = Replace(Str, vbCr, " ", 1, -1, vbBinaryCompare)
Dim SpltStr() As String
Let SpltStr() = Split(Str, " ", -1, vbBinaryCompare)
' Go through the array elements fromm the Split and build a string from any looking like URLs , I may as well join them in a string with a vbCr & vbLf as the joining but, since then i automatically have the start of a convenient form to put in the clipboard, since likely I will want to paste the URLs in a list
Dim Cnt As Long
For Cnt = LBound(SpltStr) To UBound(SpltStr)
Dim StrClp As String ' The final string to put in clipboard
If InStr(1, SpltStr(Cnt), "https://www", vbBinaryCompare) > 0 Then
Let SpltStr(Cnt) = Trim(SpltStr(Cnt)) ' I think I probably don't need this, never mind
Dim URL1 As String: Let URL1 = SpltStr(Cnt)
Dim URL2 As String: Let URL2 = Replace(URL1, "tps://ww", "[color=white]tps://ww[/color]", 1, 1, vbBinaryCompare) ' A version with disguised URL
' build the final forum post type string
Dim FrmStr As String
Let FrmStr = FrmStr & "[url=" & URL1 & "][color=white]" & URL2 & "[/color][/url]" & vbCr & vbLf
Else
' element text is not a URL
End If
Next Cnt
' Put the string in the clipboard
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
.SetText FrmStr
.PutInClipboard
End With
End Sub
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=ySENWFIkL7c
https://www.youtube.com/watch?v=ySENWFIkL7c&lc=UgyqIYcMnsUQxO5CVyx4AaABAg
https://www.youtube.com/watch?v=yVgLmj0aojI
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgwWg8x2WxLSxxGsUP14AaABAg. 9k3ShckGnhv9k89LsaigoO
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxxxIaK1pY8nNvx6JF4AaABAg. 9k-vfnj3ivI9k8B2r_uRa2
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=UgxKFXBNd6Pwvcp4Bsd4AaABAg
https://www.youtube.com/watch?v=yVgLmj0aojI&lc=Ugw9X6QS09LuZdZpBHJ4AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
Then I did this one, because like a twat I forgot where I put the last one
Code:
Sub WhiteSpamUrl() ' https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222&viewfull=1#post21222
Dim ClipTxt As String: Let ClipTxt = "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]" & vbCr & vbLf
Dim SelText As String
Let SelText = Selection.Text
Dim RwTxt() As String
Let RwTxt() = Split(SelText, vbCr, -1, vbBinaryCompare)
Dim RwCnt As Long
For RwCnt = LBound(RwTxt()) To UBound(RwTxt())
Dim ClmTxt() As String
Let ClmTxt() = Split(RwTxt(RwCnt), " ", -1, vbBinaryCompare)
Dim ClmCnt As Long
For ClmCnt = LBound(ClmTxt()) To UBound(ClmTxt())
If InStr(1, Trim(ClmTxt(ClmCnt)), "//www.", vbBinaryCompare) > 0 Then
Dim URL As String, URL2 As String
Let URL = Trim(ClmTxt(ClmCnt))
Let URL2 = Replace(URL, "http", "ht[color=white]tp[/color]", 1, 1, vbBinaryCompare)
Let URL2 = Replace(URL2, "//www.", "/[color=white]/ww[/color]w.", 1, 1, vbBinaryCompare)
Let ClipTxt = ClipTxt & "[url=" & URL & "] [color=white] " & URL2 & " [/color] [/url]" & vbCr & vbLf
Else
' no url
End If
Next ClmCnt
Next RwCnt
Let ClipTxt = ClipTxt & "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]"
' Put the string in the clipboard
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
.SetText ClipTxt
.PutInClipboard
End With
End Sub
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=vXyMScSbhk4
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgynOSp1dleo-Z8L_QN4AaABAg.9jJLDC1Z6L-9k68CuL4aTY
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgwV5N_ulFXYMNbyQG54AaABAg. 9itCkoVN4w79itOVYVvEwQ
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgyOh-eR43LvlIJLG5p4AaABAg.9isnKJoRfbL9itPC-4uckb
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugy1B1aQnHq2WbbucmR4AaABAg. 9isY3Ezhx4j9itQLuif26T
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgxxajSt03TX1wxh3IJ4AaABAg. 9irSL7x4Moh9itTRqL7dQh
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=Ugxa2VYHMWJWXA6QI294AaABAg. 9irLgSdeU3r9itU7zdnWHw
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgwJAAPbp8dhkW2X1Uh4AaABAg. 9iraombnLDb9itV80HDpXc
https://www.youtube.com/watch?v=vXyMScSbhk4&lc=UgzIzQ6MQ5kTpuLbIuB4AaABAg. 9is0FSoF2Wi9itWKEvGSSq
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
Code:
Sub WhiteSpamUrl() ' White Spam URL WhiteSpamUrl WhiteSpamUrl() [url]https://www.excelfox.com/forum/showthread.php/2348-String-text-in-Word-html-Passing-info-between-Word-and-Excel?p=21222&viewfull=1#post21222[/url] [url]https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18376&viewfull=1#post18376[/url]
Dim ClipTxt As String: Let ClipTxt = "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]" & vbCr & vbLf
Dim SelText As String
Let SelText = Selection.Text
Dim RwTxt() As String
Let RwTxt() = Split(SelText, vbCr, -1, vbBinaryCompare)
Dim RwCnt As Long
For RwCnt = LBound(RwTxt()) To UBound(RwTxt())
Dim ClmTxt() As String
Let ClmTxt() = Split(RwTxt(RwCnt), " ", -1, vbBinaryCompare)
Dim ClmCnt As Long
For ClmCnt = LBound(ClmTxt()) To UBound(ClmTxt())
If InStr(1, Trim(ClmTxt(ClmCnt)), "//www.", vbBinaryCompare) > 0 Or InStr(1, Trim(ClmTxt(ClmCnt)), "https://", vbBinaryCompare) > 0 Or InStr(1, Trim(ClmTxt(ClmCnt)), "http://", vbBinaryCompare) > 0 Then
Dim URL As String, URL2 As String
Let URL = Trim(ClmTxt(ClmCnt))
Let URL2 = Replace(URL, "http", "ht[color=white]tp[/color]", 1, 1, vbBinaryCompare)
Let URL2 = Replace(URL2, "//www.", "/[color=white]/ww[/color]w.", 1, 1, vbBinaryCompare)
Let ClipTxt = ClipTxt & "[url=" & URL & "] [color=white] " & URL2 & " [/color] [/url]" & vbCr & vbLf
Else
' no url
End If
Next ClmCnt
Next RwCnt
Let ClipTxt = ClipTxt & "[url=https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA] [COLOR=white] htt[COLOR=white]p[/COLOR]s:/[COLOR=white]/w[/COLOR]ww.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA [/color] [/url]"
' Check string length
Dim LenClipTxt As Long: Let LenClipTxt = Len(ClipTxt)
MsgBox Prompt:=LenClipTxt
' Put the string in the clipboard
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' web.archive.org/web/20200124185244/http://excelmatters.com/2013/10/04/late-bound-msforms-dataobject/
.SetText ClipTxt
.PutInClipboard
End With
End Sub
