Notes tests, Scrapping, YouTube

[DocAElstein]

Post 103 #post19742
https://excelfox.com/forum/showthrea...ge11#post19742
https://excelfox.com/forum/showthread.php/2840-Notes-tests-Scrapping-YouTube/page11#post19742

---

Part2
So I have the 9 text files, and similarly to the first attempt, ( https://excelfox.com/forum/showthrea...ll=1#post19711 ) and I will advance the coding a bit to loop all the text files.

So, as before I decide to get out all 11 digit unique YouTube bits ( like WDCmlmylNm8 ) you have in a typical YouTube video link, like https://www.youtube.com/watch?v=WDCmlmylNm8 .
I find by inspection that there seems to be all these 11 digit unique YouTube bits, (sometimes duplicated**) in some text ending with like hqdefault.jpg. So that is what is looked for, then a bit of text manipulation is done to pick out the 11 digit unique YouTube bit
The macro will, as before, check for duplicates of that 11 digit bit in each text file**, but there may be duplicates for the list from each text file as I click a bit above the last link, say on 76th link ,rather than the typical last 79th link, ( if I clicked on the 79th link I would get the unique 11 digit bit for the 79th video twice from the first two text files, by clicking on the 76th link I will get in both the first two text files the 11 digit bit for the 76th 77th 78th and 79th ) (Edit Note: I noticed later that because of the looping in Sub GetPlayListLinksFromTextFileUsinghqdefaultjpg_Popu larPlayList() results in the first few duplicates not being added. )
Here the macro:

As I am advancing the coding with looping, I will go straight into the final output worksheet, in this case worksheet ElevenDigitYT(2) , (and as Edit noted, all final duplicates are automatically removed)

Here the macro:

'   https://excelfox.com/forum/showthread.php/2840-Notes-tests-Scrapping-YouTube/page11#post19742
Sub GetPlayListLinksFromTextFileUsinghqdefaultjpg_PopularPlayList()  '   look for this - hqdefault.jpg
Rem 0a
Dim WsPop As Worksheet:  Set WsPop = ThisWorkbook.Worksheets.Item("ElevenDigitYT(2)")
'Set Ws1 = ThisWorkbook.Worksheets.Item("RoughNotes")
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 & "SecondAttemptPopular\" & Txts(Cnt)   ' "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
            If InStr(1, Unics, strURL, vbBinaryCompare) = 0 Then
             Let Unics = Unics & " " & strURL
             Dim Lr1 As Long: Let Lr1 = WsPop.Range("A" & WsPop.Rows.Count & "").End(xlUp).Row
             Dim Nr As Long
'                If WsPop.Range("B1").Value = "" Then
'                 Let Nr = 1
'                Else
                 Let Nr = Lr1 + 1
'                End If
             Let WsPop.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   '   ============================
End Sub

Here the results:
All 11 digit unique YouTube bits from hqdefault_jpg for all 9 text files.jpg






Simple macro to remove the duplicates in column A Edit: NOT NEEDED !!!
Previously this was done at the start of the main macro to get all the details I want from every video. But it’s a bit more tidier perhaps to do that quickly now, and put the unique values in column B
So I used this macro

Sub GetUnique11DigitYouTubeFromAandputinB()
Rem 0 Worksheets info
Dim WsPop As Worksheet:  Set WsPop = ThisWorkbook.Worksheets.Item("ElevenDigitYT(2)")
Dim RngWsYT11 As Range: Set RngWsYT11 = WsPop.Range("A1:A692")         '     1008")
Dim Unics As String
Dim Cnt As Long
    For Cnt = 2 To 692 ' 1009
        If InStr(1, Unics, RngWsYT11.Item(Cnt).Value2, vbBinaryCompare) = 0 Then ' Check to see if I not got this the 11 digit bit yet .....   but there may be duplicates for the list from each text file as I click a bit above the last link, say on 76th link ,rather than the typical last 79th link, ( if I clicked on the 79th link I would get the unique 11 digit bit for the 79th video twice from the first two text files, by clicking on the 76th link I will get in both the first two text files the 11 digit bit for the 76th 77th 78th and 79th )
         Let RngWsYT11.Item(Cnt).Offset(0, 1).Value2 = RngWsYT11.Item(Cnt).Value2 ' Puts the 11 digit bit in column B if i have not had that 11 digit bit yet
         Let Unics = Unics & RngWsYT11.Item(Cnt).Value2 & " " ' Put the 11 digit bit in a string which i check to see if i got this one already
        Else
         ' already got this 11 digit bit, so leave the row in column B empty
        End If
    Next Cnt
End Sub

But it did nothing!! – because of course, the looping in Sub GetPlayListLinksFromTextFileUsinghqdefaultjpg_Popu larPlayList() results in the first few duplicates not being added. Example at the start of the second main outer loop, the 76th 77th 78th and 79th would not get added
So I can forget that and take column A original to be all unique