Dış veri ile web den resim alarak dosya ismi ile resmi kayıt ederek excel e yazdırma

[mustilem23]

Merhaba ,
Dış veri alma yöntemi ile ilgi web adresinde bulunan png uzantılı resimleri alıp dosya adı ile bir klasöre kaydetmek istiyorum , akabinde excele yazdırarak bir katalog oluşturmaya çalışacağım böyle bir uygulama yapılabilir mi yardımcı olabilir misiniz,
Kaynak isimlerini alabildim lakin resimleri alabilmek mümkün olmadı yardımcı olabilir misiniz teşekkürler.
Resim kaynağı
http://www.rolleri.it/page/daten/shop/Bitmaps/neutral/

İndirilecek resim örnek
http://www.rolleri.it/page/daten/shop/Bitmaps/neutral/P.97.75.R08/big.png

inene resmi P.97.75.R08 olarak bir klasöre aldıratabilmek mümkün müdür ?.

 

[alicimri]

https://social.msdn.microsoft.com/F...opy-web-image-with-access-vba?forum=accessdev
yukardaki adresten bulduğum koda biraz düzenleme yaptım. kendinize göre uyarlayın.
1. Yöntem

Declare 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
Function DownloadFile( _
URL As String, _
LocalFilename As String _
) As Boolean
Dim lngRetVal As Long
lngRetVal = _
URLDownloadToFile(0, URL, LocalFilename, 0, 0)
DownloadFile = (lngRetVal = 0)
End Function
Sub aktar1()
For i = 5 To Range("B65536").End(3).Row
aktarim = URLDownloadToFile(0, "http://www.rolleri.it/page/daten/shop/Bitmaps/neutral/" & Range("B" & i) & "big.png", "D:\resim\" & Replace(Range("B" & i), "/", "") & ".png", 0, 0)
Next
End Sub

2. Yöntem

Private Sub aktar()
For i = 5 To Range("B65536").End(3).Row
Dim URL As String
Dim WinHttpReq As Object
Dim oStream As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
URL = "http://www.rolleri.it/page/daten/shop/Bitmaps/neutral/" & Range("B" & i) & "big.png"
WinHttpReq.Open "GET", URL, False
WinHttpReq.Send
URL = WinHttpReq.ResponseBody
If WinHttpReq.Status = 200 Then
  Set oStream = CreateObject("ADODB.Stream")
  oStream.Open
  oStream.Type = 1
  oStream.Write WinHttpReq.ResponseBody
  On Error Resume Next
  oStream.SaveToFile ("D:\resim\" & Replace(Range("B" & i), "/", "") & ".png")
  oStream.Close
End If
Next
End Sub

Kusura bakmayın İngilizce ve APİ kodlarına hakim olmadığımdan Tek kod sandım. Dikkatle inceleyince, meğer iki ayrı yöntem öneriyormuş.
Not D'ye resim klasörü oluşturun ve bir sayfaya
http://www.rolleri.it/page/daten/shop/Bitmaps/neutral/
adresindeki listeyi Veri al ile indirin, bu sayfa açık iken kodlardan birini çalıştırın, iki yöntem de işe yarıyor.

 

[alicimri]

Yukardaki kodları değiştirdim.

 

[mustilem23]

Alibey çok ama çok teşekkür ederim müthiş bir şekilde çalışıyor tüm resimleri aldım emeğinize sağlık .