(28/04/2021, 12:26)idrisy yazdı:

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _

Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _

ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long



Private Sub OgrenciAktar()

 

        Dim HTML_Body As Object, HTML_Tables As Object, MyTable As Object

        

        Dim X As Integer, Y As Integer, Z As Integer, A As Integer

        Set HTML_Body = WebBrowser1.Document.all

        Set HTML_Tables = HTML_Body.tags("Table")

        Set MyTable = HTML_Tables("dgListe")

        Set HTML_TableRows = MyTable.getElementsByTagName("td")

        

        Dim HTML_Img As Object, AlinanResim As Object

        Dim TempDir As String

  

        

        For Each MyRow In HTML_TableRows

        X = X + 1

        Next

        

        Z = (X - 5) / 5

        'On Error Resume Next



        ReDim Sorgu(15, Z - 1)

        X = 0



        For X = 0 To Z - 1

        Y = 1 + (1 * X)



        

        

        Next X



        A = 0

        X = 0

        For X = 0 To Z - 1

            Set HTML_Img = MyTable.getElementsByTagName("img")



            Set AlinanResim = HTML_Img(A)

        'HTML_Img(1).SetFocus

        TempDir = Environ("Temp")

        URLDownloadToFile 0, AlinanResim.src, TempDir & "\" & Mid(HTML_Img(A).src, InStr(1, HTML_Img(A).src, "=") + 1, 11) & ".png", 0, 0

        Me.resim1.Picture = TempDir & "\" & Mid(HTML_Img(A).src, InStr(1, HTML_Img(A).src, "=") + 1, 11) & ".png"



        URLDownloadToFile 0, AlinanResim.src, CurrentProject.path & "\Resimler\" & Mid(HTML_Img(A).src, InStr(1, HTML_Img(A).src, "=") + 1, 11) & ".jpg", 0, 0

        MetinSrc = Mid(HTML_Img(A).src, InStr(1, HTML_Img(A).src, "=") + 1, 11) 'HTML_Img(A).src

        

        A = A + 1

        Next X

        



Set HTML_Body = Nothing

Set HTML_Tables = Nothing

Set MyTable = Nothing

Set HTML_TableRows = Nothing

End Sub

atoykan hocam; accesste yukarıdaki kod ile resimleri alabiliyorum ancak excelle uyarlayamadım.
Yardım edebilirseniz sevinirim.

Dosyanın çalışır halini eklerseniz excele uyarlarız elimizden gelirse.