Question: Extract predefined URL text (starts with the same prefix) into an Array

I have files URLs text like these examples:
http://xxxxx.pdf http://xxxxxxxxxxx.doc http://xxxxxxxxxxxxx.xls
The delimiter between each URL is not a space, it may be separated by vbTab , vbLf or what ever.
But in all cases the URLs start with the same prefix "http:" and end with a dot+three characters.
I need to extract these predefined URLs into an Array to manipulate it later.
I made the below code as a workaround, by using two arrays and also I had to start looping from the second element from the first array because I found there is extra "http" on the second array.
My question, Is there another neater code?
Sub Split_URLs_to_Array()

  Dim wDoc As Word.Document, rngSel As String
  Dim arrS, arrD, i As Long
  
  Set wDoc = Application.ActiveInspector.WordEditor
  
  rngSel = Trim(wDoc.Windows(1).Selection.Text)

  arrS = Split(rngSel, "http")
  
  ReDim arrD(0 To UBound(arrS))
  
   For i = 1 To UBound(arrS)
       arrD(i) = "http" & arrS(i)
     Debug.Print arrD(i)
   Next

End Sub 
 



Answer:

You asked (yesterday) about a way to extract URLs from a string, separated by no any separator... The next function will do it:

Function SplitByStartOfString(strTxt As String, strDelim As String) As Variant
  Dim arr: arr = Split(strTxt, strDelim)
  
  arr(0) = "@#$%^": arr = filter(arr, "@#$%^", False) 'eliminate the first empty element
  SplitByStartOfString = Split(strDelim & Join(arr, "|" & strDelim), "|")
End Function

It can be tested in the next way:
Sub testSplitByStartOfString()
   Dim x As String: x = "https://myurl1/x.pdfhttps://myurl2/y.xlsxhttps://myurl3/z.docx"
   Dim arr
   arr = SplitByStartOfString(x, "https:")
   Debug.Print Join(arr, "||") 'just to visually see the array result.
End Sub

Of course, you can use what strings you know, the delimiter will be the common prefix of each of them...
And end of line separators or VbTab exists, the above code will also work, but these separators will be included of the end of the string. Which, for URL in Outlook will not count. They will only be arranged using the respective separator.
1.1 Another function, using FilterXML may be the next one:
Function splitXMLByStartOfString(strText As String, strDelim As String) As Variant
    Dim XML As String: XML = "<t>
" & VBA.Replace(strText, strDelim, "

" & strDelim) & "
</t>"
    splitXMLByStartOfString = Application.FilterXML(XML, "//s[position()>1]")  'nodes starting from the second one...
    'splitXMLByStartOfString = Application.FilterXML(XML, "//s[count(node())>0]")   'another working way (all not empty nodes)
    'splitXMLByStartOfString = Application.FilterXML(XML, "//s[starts-with(., '" & strDelim & "')]") 'working way, too (nodes starting with strDelim)
End Function

It can be tested using the next sub:
Sub TestFilterXMLHttp()
   Dim x As String: x = "https://myurl1/x.pdfhttps://myurl2/y.xlsxhttps://myurl3/z.docx"
   Dim arr: arr = splitXMLByStartOfString(x, "https:") 'It returns a 2D, 1 column array...
  
   Debug.Print Join(Application.Transpose(arr), "||")
End Sub

The above function works well and fast, but in Excel. The question does not mention that it should be used in Outlook VBA (but I knew about that...). So, the next solution uses an automation from Outlook, and use Excel.Application it this way. This version needs an Excel session open, but it can be easily adapted to open a new one if nothing open:
Function splitXMLByStartOfString(strText As String, strDelim As String, objEx As Object) As Variant
   
    Dim XML As String: XML = "<t>
" & VBA.Replace(strText, strDelim, "

" & strDelim) & "
</t>"
    splitXMLByStartOfString = objEx.FilterXML(XML, "//s[position()>1]")  'nodes starting from the second one...
    'splitXMLByStartOfString = Application.FilterXML(XML, "//s[count(node())>0]")   'another working way (all not empty nodes)
    'splitXMLByStartOfString = Application.FilterXML(XML, "//s[starts-with(., '" & strDelim & "')]") 'working way, too (nodes starting with strDelim)
End Function

And the sub to test it, using the above mentioned automation:
Sub TestFilterXMLHttp()
   Dim objEx As Object: Set objEx = GetObject(, "Excel.application")
   Dim x As String: x = "https://myurl1/x.pdfhttps://myurl2/y.xlsxhttps://myurl3/z.docx"
   Dim arr: arr = splitXMLByStartOfString(x, "https:", objEx) 'It returns a 2D, 1 column array...
  
   Debug.Print Join(objEx.Transpose(arr), "||")
End Sub


Extracting an array from string elements separated by one from more supposed separators can be extracted using the next function:

Function extractFromStringSep(strText As String) As Variant
   Dim arrC: arrC = Array(vbTab, vbLf) 'you can extend the supposed separators...
   Dim El
   
   For Each El In arrC
        If InStr(strText, El) > 0 Then
            extractFromStringSep = Split(strText, El): Exit Function
        End If
   Next El
End Function

Of course, the string to be extracted must NOT contain the supposed separators...
It can be tested like in the next sub:
Sub TestextractFromStringSep()
   Dim x As String: x = "https://myurl1/x.pdf" & vbTab & "https://myurl2/y.xlsx" & vbTab & "https://myurl3/z.docx"
          'x = "https://myurl1/x.pdf" & vbLf & "https://myurl2/y.xlsx" & vbLf & "https://myurl3/z.docx"
   Dim arr
   arr = extractFromStringSep(x)
   Debug.Print Join(arr, "||") 'just to visually see the array result.
End Sub


And a last version, also allowing part of the url string as separator (only for didactic purpose):

Function extractFromStrAndSep(strText As String, strDelim As String) As Variant
     Dim arrC: arrC = Array(vbTab, vbLf, "myur") 'you can extend the supposed separators...
     Dim El
     
     For Each El In arrC
        If InStr(strText, El & strDelim) > 0 Then
            extractFromStrAndSep = Split(strText, El & strDelim): Exit Function
        End If
   Next El
End Function

Tested with the next (adapted) sub:
Sub TestextractFromStrAndSep()
   Dim x As String: 'x = "https://myurl1/x.pdf" & vbTab & "https://myurl2/y.xlsx" & vbTab & "https://myurl3/z.docx"
          'x = "https://myurl1/x.pd" & vbLf & "https://myurl2/y.xlsx" & vbLf & "https://myurl3/z.docx"
          x = "https://myurl1/x.pd" & "myur" & "https://myurl2/y.xlsx" & "myur" & "https://myurl3/z.docx"
   Dim arr
   arr = extractFromStrAndSep(x, "https:")
   Debug.Print Join(arr, "||") 'just to visually see the array result.
End Sub