THIS is new for me

[sal21]

during this code retrive an alert message , see image:

Private Sub TEST_OK()

    Dim I As Long, TEXT As String, REQ As Object, DOC As Object, TABL As Object, TR As Object, LINK As Object, URL As String
    Dim N As Integer

    Set REQ = CreateObject("Msxml2.XMLHTTP")
    Set DOC = CreateObject("htmlfile")
    REQ.Open "GET", "https://www.aifa.gov.it/liste-dei-farmaci", False
    REQ.send
    DOC.body.innerHTML = REQ.responseText
    
    N = 0

    For Each TABL In DOC.getElementsByTagName("table")
    
        For Each TR In TABL.getElementsByTagName("tr")
        
            TEXT = TR.innerText
            If InStr(1, TEXT, "Data ultimo aggiornamento:", vbTextCompare) Then
                I = I + 1
                DTAGG = Trim(Split(TEXT, ":")(1))
                If Not IsNumeric(Left(DTAGG, 2)) Then
                    Call TRANSFOR_DATE(DTAGG)
                End If
                Exit For
            End If
        Next TR
        
        For Each LINK In TABL.getElementsByTagName("a")
        
            TEXT = LINK.href
            TEXT = Replace(TEXT, "about:/", "https://www.aifa.gov.it/")
            
            URL = TEXT
            
            If InStr(1, URL, "registri", vbTextCompare) = 0 Then
                Call DownloadFileFromURL(URL)
                NOMEFILE = UCase(Mid(URL, InStrRev(URL, "/") + 1))
                SQL = "INSERT INTO FARMACI (DTAGG, URL, NOME_FILE) VALUES ('" & DTAGG & "','" & URL & "','" & NOMEFILE & "')"
                CON.Execute (SQL)
                N = N + 1
            End If
            
        Next LINK

    Next TABL

End Sub

trnslate in english from italian:
avviso di sicurezza WINDOWS

to allow the website to provide personalized information it is necessary to download a small file called a cookie to your computer. download the file?

 

[strongm]

Yes, so Cookie-related. MSXML has some limitations on handing cookies via automation.

Can you please provide your actual code, rather than a screen shot, as I have some thoughts but I'm not going to type in your code from scratch.

 

[sal21]

stronsm, tks as usual!
my original code:

Private Sub TEST_OK()

    Dim I As Long, TEXT As String, REQ As Object, DOC As Object, TABL As Object, TR As Object, LINK As Object, URL As String
    Dim N As Integer

    Set REQ = CreateObject("Msxml2.XMLHTTP")
    Set DOC = CreateObject("htmlfile")
    REQ.Open "GET", "https://www.aifa.gov.it/liste-dei-farmaci", False
    REQ.send
    DOC.body.innerHTML = REQ.responseText
  
    N = 0

    For Each TABL In DOC.getElementsByTagName("table")
        For Each TR In TABL.getElementsByTagName("tr")
            TEXT = TR.innerText
            If InStr(1, TEXT, "Data ultimo aggiornamento:", vbTextCompare) Then
                I = I + 1
                DTAGG = Trim(Split(TEXT, ":")(1))
                If Not IsNumeric(Left(DTAGG, 2)) Then
                    Call TRANSFOR_DATE(DTAGG)
                End If
                Exit For
            End If
        Next TR
        For Each LINK In TABL.getElementsByTagName("a")
            TEXT = LINK.href
            TEXT = Replace(TEXT, "about:/", "https://www.aifa.gov.it/")
            URL = TEXT
          
            If InStr(1, URL, "registri", vbTextCompare) = 0 Then
                Call DownloadFileFromURL(URL)
                NOMEFILE = UCase(Mid(URL, InStrRev(URL, "/") + 1))
                SQL = "INSERT INTO FARMACI (DTAGG, URL, NOME_FILE) VALUES ('" & DTAGG & "','" & URL & "','" & NOMEFILE & "')"
                CON.Execute (SQL)
                N = N + 1
            End If
        Next LINK

    Next TABL

End Sub
Public Sub DownloadFileFromURL(URL As String)

    Dim FileUrl As String
    Dim objXmlHttpReq As Object
    Dim objStream As Object, FileName As String

    FileUrl = URL

    FileName = UCase(Mid(URL, InStrRev(URL, "/") + 1))

    Set objXmlHttpReq = CreateObject("Microsoft.XMLHTTP")
    objXmlHttpReq.Open "GET", FileUrl, False, "username", "password"
    objXmlHttpReq.send

    If objXmlHttpReq.Status = 200 Then
        Set objStream = CreateObject("ADODB.Stream")
        objStream.Open
        objStream.Type = 1
        objStream.Write objXmlHttpReq.responseBody
        objStream.SaveToFile "C:\Lavori_Vb6\FARMACI\FILES\" & FileName, 2    ' 1 = no overwrite, 2 = overwrite
        objStream.Close
    End If

    Set objXmlHttpReq = Nothing

    'Call LEGGI_FILE(FileName)

End Sub

Private Sub TRANSFOR_DATE(DTAGG)

    Dim D As Date
    Dim M As Variant
    Dim T() As String
    Dim I As Long
    Dim MyString As String    ', DT As Date

    M = Array(Array("Gennaio", "01"), Array("Febbraio", "02"), Array("Marzo", "03"), Array("Aprile", "04"), Array("Maggio", "05"), Array("Giugno", "06"), Array("Luglio", "07"), Array("Agosto", "08"), Array("Settembre", "09"), Array("Ottobre", "10"), Array("Novembre", "11"), Array("Dicembre", "12"))    'Add other Months

    MyString = DTAGG

    If Not IsDate(MyString) Then
        T = Split(MyString, " ")
        For I = LBound(M, 1) To UBound(M, 1)
            If T(0) = M(I)(0) Then  'Month found
                D = DateAdd("d", -1, DateAdd("m", 1, DateSerial(CInt(T(1)), CInt(M(I)(1)), 1)))
                Exit For
            End If
        Next
    Else
        D = DateAdd("d", -1, DateAdd("m", 1, CDate(MyString)))
    End If
    DTAGG = D

End Sub

 

[sal21]

Yes, so Cookie-related. MSXML has some limitations on handing cookies via automation.

Can you please provide your actual code, rather than a screen shot, as I have some thoughts but I'm not going to type in your code from scratch.

hi bro.
i have posted my original code

 

[strongm]

Yep - can't find a workable Msxml2.XMLHTTP solution to this currently