Notes tests, Scrapping, YouTube

[DocAElstein]

---

We know what to do with that, just like all the other #xx2 posts in this Thread, using something like this…._

Option Explicit
Sub KevDevURLServerChromeLearnDavKev()   '    https://excelfox.com/forum/showthread.php/2840-Notes-tests-Scrapping-YouTube/page12#post19743                  https://eileenslounge.com/viewtopic.php?p=303644#p303644   https://excelfox.com/forum/showthread.php/2840-Notes-tests-Scrapping-YouTube/page11#post19741  https://excelfox.com/forum/showthread.php/2656-Automated-Search-Results-Returning-Nothing            https://excelfox.com/forum/showthread.php/973-Lookup-First-URL-From-Google-Search-Result-Using-VBA
 On Error GoTo Bed
'_1 First section get the long text string of the HTML coding of the internet Page
'_1(i) get the long single text string
'Dim strURLs As String: Let strURLs = "https://www.youtube.com/watch?v=Cy4_zrFja2w&list=UULFwInqvNXb-GN0JHdtoul_9A&index=1" & vbCr & vbLf & _
'"https://www.youtube.com/watch?v=d_RO2VIcFYw&list=UULFwInqvNXb-GN0JHdtoul_9A&index=76" & vbCr & vbLf & _
'"https://www.youtube.com/watch?v=gKNh43aEw_E&list=UULFwInqvNXb-GN0JHdtoul_9A&index=151" & vbCr & vbLf & _
'"https://www.youtube.com/watch?v=JzU7jFWbA6s&list=UULFwInqvNXb-GN0JHdtoul_9A&index=226" & vbCr & vbLf & _
'"https://www.youtube.com/watch?v=g_1_saf0E1I&list=UULFwInqvNXb-GN0JHdtoul_9A&index=301" & vbCr & vbLf & _
'"https://www.youtube.com/watch?v=IAIESH9vPbk&list=UULFwInqvNXb-GN0JHdtoul_9A&index=376" & vbCr & vbLf & _
'"https://www.youtube.com/watch?v=9u372_W07Nw&list=UULFwInqvNXb-GN0JHdtoul_9A&index=451" & vbCr & vbLf & _
'"https://www.youtube.com/watch?v=6SDkQ-iMrC4&list=UULFwInqvNXb-GN0JHdtoul_9A&index=526" & vbCr & vbLf & _
'"https://www.youtube.com/watch?v=EWr8G0r89k0&list=UULFwInqvNXb-GN0JHdtoul_9A&index=601"
'Dim URLs() As String: Let URLs() = Split(strURLs, vbCr & vbLf, 9, vbBinaryCompare)
'Dim Cnt As Long
'    For Cnt = LBound(URLs()) To UBound(URLs())
    Dim strURL As String, Indx As String
'     Let strURL = URLs(Cnt)
Let strURL = "https://www.youtube.com/watch?v=EEksPdEc7aI&list=PLlKpQrBME6xI-i6cL8Vdg2LOgjuawizcm&index=1"
Let Indx = Right(strURL, Len(strURL) - InStrRev(strURL, "&", -1, vbBinaryCompare))
Let Indx = Replace(Indx, "=", "_", 1, 1, vbBinaryCompare)
       With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", strURL, False ' '
        '.Open "GET", "", False ' '
        'No extra info here for type GET
        '.setRequestHeader bstrheader:="Ploppy", bstrvalue:="PooH" ' YOU MAY NEED TO TAKE OUT THIS LINE
                                                                                   '.setRequestHeader bstrheader:="If-Modified-Since", bstrvalue:="Sat, 1 Jan 2000 00:00:00 GMT" '  https://www.autohotkey.com/boards/viewtopic.php?t=9554  ---   It will caching the contents of the URL page. Which means if you request the same URL more than once, you always get the same responseText even the website changes text every time. This line is a workaround : Set cache related headers.
        .setRequestHeader "User-Agent", "Chrome"  '  https://eileenslounge.com/viewtopic.php?p=303639#p303639
        .send ' varBody:= ' No extra info for type GET. .send actually makes the request
           While .readyState <> 4: DoEvents: Wend ' Allow other processes to run while the web page loads. Think this is part of the True option
       Dim PageSrc As String: Let PageSrc = .responseText ' Save the HTML code in the (Global) variable. ': Range("P1").Value = PageSrc 'For me for a print out copy to text file etc.    The responseText property returns the information requested by the Open method as a text string
       End With
   '_1(ii)  Optional secion  to put the text string into a text file , for ease of code developments
   Dim FileNum2 As Long: Let FileNum2 = FreeFile(0)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
   Dim PathAndFileName2 As String
    Let PathAndFileName2 = ThisWorkbook.Path & "\" & "\KevDev\" & "KevDevServerChrome" & Indx & ".txt" ' "WieGehtsYouTubeServerChrome526" & ".txt" ' "WieGehtsYouTubeServerChrome451" & ".txt" '  "WieGehtsYouTubeServerChrome376" & ".txt" '  "WieGehtsYouTubeServerChrome301" & ".txt" '  "WieGehtsYouTubeServerChrome226" & ".txt" '  "WieGehtsYouTubeServerChrome151" & ".txt" '  "WieGehtsYouTubeServerChrome76" & ".txt"   '   "WieGehtsYouTubeServerChrome1" & ".txt"   '
   Open PathAndFileName2 For Output As #FileNum2 ' ' The text file will be made if not there, and if it is there and already contains data, then the data will be overwritten
    Print #FileNum2, PageSrc '
    Close #FileNum2
'    Next Cnt
Exit Sub  '  Normal code error in the case of no errors
Bed:
 MsgBox Prompt:=Err.Number & ":  " & Err.Description: Debug.Print Err.Number & ":  " & Err.Description
End Sub   ' Code end in the case of any error

_... to get this: