Notes tests, Scrapping, YouTube

[DocAElstein]

#133 #post19765 https://excelfox.com/forum/showthrea...ge14#post19765

---

just like all the other #xx3 posts in this Thread, using something like this…._

Sub GetPlayListLinksFromTextFileUsinghqdefaultjpg_DavKev()  '   look for this - hqdefault.jpg
Rem 0a
Dim WsDK As Worksheet:  Set WsDK = ThisWorkbook.Worksheets.Item("LearnDavKev")
'Rem 0b) An Array of all the 9 text files got from the last macro   Sub WieGehtsYouTubeURLServerChromeHybridStep75_2()
'Dim strTxts As String: Let strTxts = "WieGehtsYouTubePopularServerChromeindex_1.txt" & vbCr & vbLf & _
'"WieGehtsYouTubePopularServerChromeindex_76.txt" & vbCr & vbLf & _
'"WieGehtsYouTubePopularServerChromeindex_151.txt" & vbCr & vbLf & _
'"WieGehtsYouTubePopularServerChromeindex_226.txt" & vbCr & vbLf & _
'"WieGehtsYouTubePopularServerChromeindex_301.txt" & vbCr & vbLf & _
'"WieGehtsYouTubePopularServerChromeindex_376.txt" & vbCr & vbLf & _
'"WieGehtsYouTubePopularServerChromeindex_451.txt" & vbCr & vbLf & _
'"WieGehtsYouTubePopularServerChromeindex_526.txt" & vbCr & vbLf & _
'"WieGehtsYouTubePopularServerChromeindex_601.txt"
'Dim Txts() As String: Let Txts() = Split(strTxts, vbCr & vbLf, 9, vbBinaryCompare)
    
'Dim Cnt As Long
'    For Cnt = LBound(Txts()) To UBound(Txts())    ' Loop all the text files got from the last macro   Sub WieGehtsYouTubeURLServerChromeHybridStep75_2() ==
    ' Rem 1 Get the text files as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1)                                    ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 '                                             Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "WieGehtsYouTubeServerChrome.txt"   '
' Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "GettingStarted\" & Txts(Cnt)   ' "WieGehtsYouTubeServerChrome601.txt" ' "WieGehtsYouTubeServerChrome526.txt" ' "WieGehtsYouTubeServerChrome451.txt" ' "WieGehtsYouTubeServerChrome376.txt" ' "WieGehtsYouTubeServerChrome301.txt" ' "WieGehtsYouTubeServerChrome226.txt" ' "WieGehtsYouTubeServerChrome151.txt" '  "WieGehtsYouTubeServerChrome76.txt" '  '"WieGehtsYouTubeServerChrome1.txt"   '
 Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "KevDev\" & "KevDevServerChromeindex_1.txt"                                           ' "WieGehtsYouTubeServerChrome601.txt" ' "WieGehtsYouTubeServerChrome526.txt" ' "WieGehtsYouTubeServerChrome451.txt" ' "WieGehtsYouTubeServerChrome376.txt" ' "WieGehtsYouTubeServerChrome301.txt" ' "WieGehtsYouTubeServerChrome226.txt" ' "WieGehtsYouTubeServerChrome151.txt" '  "WieGehtsYouTubeServerChrome76.txt" '  '"WieGehtsYouTubeServerChrome1.txt"   '
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundamental type data input...
' Let TotalFile = Space(LOF(FileNum)) '....and wot receives it has to be a string of exactly the right length
'Get #FileNum, , TotalFile
'  Or  http://www.eileenslounge.com/viewtopic.php?p=295782&sid=f6dcab07c4d24e00e697fe4343dc7392#p295782
 Let TotalFile = Input(LOF(FileNum), FileNum)
Close #FileNum
' Rem 2 Get all links based on the unique bit of index=x, where x is 1 2 3 4 ...... etc
'                   Dim Cnt As Long: Let Cnt = 1
Dim TextBit As String: Let TextBit = TotalFile
Dim posJpg As Long: Let posJpg = InStr(1, TextBit, "hqdefault.jpg", vbBinaryCompare)
    Do While posJpg <> 0
    Dim strURL As String: Let strURL = Mid(TextBit, posJpg - 12, 11)
    Dim Unics As String  '  This is mainly because sometimes the same 11 digit bit  appears a few times in a text file,    But Note that because I dont initialise / reset this then, unlike the previous code done once for each text file,  I will also catch the duplicates caused by me overlapping the URLs that I used, like , example at the start of the second main outer loop, the 76th 77th 78th and 79th would not get added
        If InStr(1, Unics, strURL, vbBinaryCompare) = 0 Then
         Let Unics = Unics & " " & strURL
         Dim Lr1 As Long: Let Lr1 = WsDK.Range("A" & WsDK.Rows.Count & "").End(xlUp).Row
         Dim Nr As Long
            If WsDK.Range("A1").Value = "" Then
             Let Nr = 1
            Else
             Let Nr = Lr1 + 1
            End If
         Let WsDK.Range("A" & Nr & "").Value = strURL
            
        Else ' Got a dup
'             Let WsPop.Range("C" & Nr & "").Value = WsPop.Range("C" & Nr & "").Value + 1 ' for count of dups
        End If
     Let TextBit = Mid(TextBit, posJpg + 1)
     Let posJpg = InStr(1, TextBit, "hqdefault.jpg", vbBinaryCompare)
    Loop
'    Next Cnt   '   ============================
WsDK.Columns(1).AutoFit
End Sub

_... give something like this

Note: quite a few more ( 26 ) than the 6 of the Play List