String text in Word html. Passing info between Word and Excel

**DocAElstein** · 07-09-2023, 05:20 PM

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

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

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

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

**DocAElstein** · 07-09-2023, 05:20 PM

Code:

Sub FuckoffvbCrandvbLfinwordtext()  '   https://www.excelfox.com/forum/showthread.php/2824-Tests-Copying-pasting-Cliipboard-issues?p=18377&viewfull=1#post18377
Dim ClipTxt As String ': Let ClipTxt = "  https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA  " & vbCr & vbLf
Dim SelText As String
 Let SelText = Selection.Text

 Let ClipTxt = Replace(SelText, vbCr, "", 1, -1)
 Let ClipTxt = Replace(ClipTxt, vbLf, "", 1, -1)
'   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