Resim indirme

[Lanvin]

Merhaba,

Aşağıda resimlerini yüklediğim sorum için yanıt arıyorum.
Yardımcı olabilirmisiniz?

Yapmaya çalıştığım şu 1. çalışma sayfasında her hangi bir hücreye veya nesneye tıklayarak ona köprüledeğim 2. çalışma sayfasındaki resmi farklı kaydebilmek.

İşlem tamamlandığında RESİMLER sayfası gizli konumda olacak.
Köprü ile o sayfadan resim çekmek istiyorum.

Eğer başka veya farklı bir uygulama varsa yönlendirmelerinizi de bekliyorum.

Teşekkürler..

 

[nejdetsev]

Excel ile resim indirme indirlilen resimlerin adını değiştirme

merhaba arkadaşlar
Excel.web.tr excel konusunda başvurduğum ve çoğu zamanda aradığımı bulduğum bir site web master e çok teşekkür ederim.
benim sorunum şu:
sitemde bulunan ve linklerini bildiğim binlerce ürün resimi var. bu resim linklerimi kendim siteden alabiliyorum.
göndermiş olduğum örnek dosyada 1.sütunda ürün resim linkleri 2.sütunda o ürünün stok kodları var.ben excele örneğin ürün resim linklerini ve stok kodlarını yüklediğim zaman ürün resim linkini açacak resim adını yanındaki stok adı yapıp masa üstünde belirttiğim dosyaya kayıt edecek, sonra alttaki linki açıp aynı şekilde o resminde adını yanındaki stok kodu.jpg olarak kayıt edecek bu böyle son linke kadar devam edip hepsinin resimlerini indirecek.

böyle bir macro var mı? varsa lütfen linkini verin.
yoksa böyle bir macro yazılabilir mi?

yardımcı olacağınız düşüncesi ile

saygılarımla

 

[Murat OSMA]

Dahah önce sitede paylaşmıştım.

Deneyiniz;

Sub Evn()
    Dim i As Integer
    Dim WShel As Object
    Dim a As String

    basla = Timer
    Set WShel = CreateObject("WScript.Shell")
    a = WShel.SpecialFolders("Desktop")

    Const MsgText = "Dosyalar İndirilsin mi ?"
    Const MsgHdr = "İnidiriliyor..."
    If MsgBox(MsgText, vbYesNo Or vbMsgBoxRtlReading Or vbExclamation, MsgHdr) _
        = vbYes Then
    MkDir (a & "\Evn Download")
    For i = 2 To Range("A65536").End(3).Row
    Cells(i, "C").Value = Right(Cells(i, "A"), 3)
    URL$ = Cells(i, "A").Value
    dosya$ = a & "\Evn Download" & "\" & Cells(i, "B").Value & "." & Cells(i, "c").Value
    DownloadFile URL$, dosya$
    'CreateObject("Wscript.shell").Run """" & dosya$ & """" - Dosyayı çalıştır...
    Next i
    End If
    
    bitir = Timer - basla
    MsgBox "İndirme işlemi " & Format(bitir, "00:00:00.00") & " sürede tamamlanmıştır. ", _
     vbInformation + vbMsgBoxRtlReading, "Www"
    i = Empty
    a = vbNullString
    Set WShel = Nothing
End Sub

Function DownloadFile(ByVal URL$, ByVal LocalPath$) As Boolean
    Dim XMLHTTP, ADOStream, FileName
    On Error Resume Next: Kill LocalPath$
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False"
    XMLHTTP.send
    If XMLHTTP.statustext = "OK" Then
    Set ADOStream = CreateObject("ADODB.Stream")
    ADOStream.Type = 1: ADOStream.Open
    ADOStream.Write XMLHTTP.responseBody
    ADOStream.SaveToFile LocalPath$, 2
    ADOStream.Close: Set ADOStream = Nothing
    DownloadFile = True
    Else
    MsgBox "Bağlantı sağlanamadı", vbInformation, "Hata !"
    End If
    Set XMLHTTP = Nothing
End Function

 

[snx111]

üst üste ikinci indirme yapılınca Patch File error veriyor buna bir çözüm var mı ?

 

[Murat OSMA]

Oluşturulan klasörü silip yeniden ekleyebilirsiniz. Ya da aynı klasör içine kaydedebilirsiniz. Ya da her seferinde farklı klasör içine kaydedebilirsiniz. vs. vs. vs.

Sitede bu konuda örnekler var.

 

[nejdetsev]

Merhaba Murat bey
size ne kadar teşekkür etsem azdır.
çok saolun işimi süper halletti. ve çok hızlı çalışıyor. ben bu işleri aylarca uğraşsam bitiremezdim. dakikada halletti

sağolun

 

[Murat OSMA]

Bilginiz olsun: sadece resimleri değil, tüm dosyaları indirebilirsiniz...

İyi akşamlar...

 

[snx111]

Murat bey Şu evn download klasöründe dosya varsa msgbox > "klasör dolu " yoksa sorgusuz devam et komutu ekleyebilirmisiniz size zahmet olmazsa ?

 

[halit3]

Murat bey Şu evn download klasöründe dosya varsa msgbox > "klasör dolu " yoksa sorgusuz devam et komutu ekleyebilirmisiniz size zahmet olmazsa ?

Murat beyin koduna küçük ilaveler yaptım.
Klasör oluşturma işlemide tamam

Sub Evn()
Dim i As Integer
basla = Timer
Const MsgText = "Dosyalar İndirilsin mi ?"
Const MsgHdr = "İnidiriliyor..."
If MsgBox(MsgText, vbYesNo Or vbMsgBoxRtlReading Or vbExclamation, MsgHdr) = vbYes Then
Klasor = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Evn Download"
If CreateObject("Scripting.FileSystemObject").FolderExists(Klasor) = False Then
MkDir (Klasor)
End If
For i = 2 To Range("A65536").End(3).Row
Cells(i, "C").Value = Right(Cells(i, "A"), 3)
URL$ = Cells(i, "A").Value
Dosya$ = Klasor & "\" & Cells(i, "B").Value & "." & Cells(i, "c").Value
If CreateObject("Scripting.FileSystemObject").FileExists(Dosya$) = True Then
MsgBox Dosya$ & Chr(10) & Chr(10) & "Bu dosya var"
Else
DownloadFile URL$, Dosya$
End If
'CreateObject("Wscript.shell").Run """" & dosya$ & """" - Dosyayı çalıştır...
Next i
End If
bitir = Timer - basla
MsgBox "İndirme işlemi " & Format(bitir, "00:00:00.00") & " sürede tamamlanmıştır. ", _
vbInformation + vbMsgBoxRtlReading, "Www"
i = Empty
End Sub
 
 
Function DownloadFile(ByVal URL$, ByVal LocalPath$) As Boolean
    Dim XMLHTTP, ADOStream, FileName
    On Error Resume Next: Kill LocalPath$
    Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
    XMLHTTP.Open "GET", Replace(URL$, "\", "/"), "False"
    XMLHTTP.send
    If XMLHTTP.statustext = "OK" Then
    Set ADOStream = CreateObject("ADODB.Stream")
    ADOStream.Type = 1: ADOStream.Open
    ADOStream.Write XMLHTTP.responseBody
    ADOStream.SaveToFile LocalPath$, 2
    ADOStream.Close: Set ADOStream = Nothing
    DownloadFile = True
    Else
    MsgBox "Bağlantı sağlanamadı", vbInformation, "Hata !"
    End If
    Set XMLHTTP = Nothing
End Function

 

[Murat OSMA]

Merhaba Halit Bey, ilgilendiğiniz için teşekkür ederim.

İyi akşamlar...

 

[halit3]

Merhaba Halit Bey, ilgilendiğiniz için teşekkür ederim.

İyi akşamlar...

Teşekkürler Murat bey Hayırlı akşamlar.

 

[snx111]

Teşekkürler .......

 

[snx111]

Bilginiz olsun: sadece resimleri değil, tüm dosyaları indirebilirsiniz...

İyi akşamlar...

Murat bey kodları biraz inceledim inecek dosyayı kendi ismiyle indiremiyoruz ;
inecek dosyanın uzantısınıda belirtmek gerekiyor normal downloader gibi çalışması için kodu modifiye edermisiniz bu kodlamanın bu yapısından anlamıyorum malesef..

 

[halit3]

9 nolu mesajdaki kodun bu bölümü yerine

Dosya$ = Klasor & "\" & Cells(i, "B").Value & "." & Cells(i, "c").Value

Bunu denermisiniz.

Dosya$ = Klasor & "\" & Right(URL$, InStr(1, StrReverse(URL$), "/", vbTextCompare) - 1)

Not: Dosyanın tam adresi zaten A sutünunda var.

 

[HALILİBRAHIM]

Merhaba Halit Hocam bir örnek excel dosyası ile örneklendirmeniz mümkünmüdür.Sanırım yukarıdaki dosya silinmiş.
Ben yaptığımda Bağlantı Sağlanamadı hatası alıyorum.
Teşekkür ederim

 

[HALILİBRAHIM]

Halit Hocam,

link yapsından mı bilmiyorum ama aşağıdaki link adres çubuğundan sıkıntı olmadan geliyor.Fakat Makro hata veriyor ama diğer linklerde denedim çalışıyor.

http://www.hirdavat24.com/myassets/products/398/pr_01_398.jpg?rev=1453718279

http://www.hirdavat24.com/myassets/products/398/pr_01_398.jpg


İki türlüde denedim hata alıyorum hocam gerçekten olursa mükemmel bir iş olacak yardımlarınızı rica ederim Halit ve Murat Hocam,

Teşekkürler.

 

[sinankapci]

Teşekkür...

 

[mrt.byc]

hocam merhabalar ben excel de acemi biri olduğumu söyleyerek başlayayım söze.
elimde a sütununda fotoğraf linkleri ve b sütununda barkodları olan kitap1 adında bir dosyam var.
bu fotoğrafları barkodların ismini vererek pc ye kaydetmek istiyorum.
yukarıda kodlar var ama indirme yerini nereye yazacağım. makroyu nasıl uygulayacağımı, kodları ne yapacağımı bilmiyorum
yardım ederseniz çok sevinirim.
ilgilendiğiniz için şimdiden teşekkürler