Skip to main content

AccessTr.neT


Excel Makro İle Web Sayfasından Resim Alma

Excel Makro İle Web Sayfasından Resim Alma

#11

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.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
RE: Excel Makro İle Web Sayfasından Resim Alma - Yazar: idrisy - 28/04/2021, 12:26