[Yardım]  WEB uzerinden dosya indirme koduna revizyon.Acil lutfen

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

WEB uzerinden dosya indirme koduna revizyon.Acil lutfen

İleti#1)  makss123 » 14 Mar 2019 09:16

Merhaba Arkadaslar,

Web uzerinden .pdf uzantili linkleri indirebiliyorum asagidaki kod ile fakat her pdf uzantisi farkli numara atiyor yanina bundan dolayi islemi seri sekilde devam ettiremiyorum.

Bu koda ilk once web sayfasini acicak sonra .pdf uzantili linki listeleyip indirme islemini bu sekilde devam edecek bir ekleme yapilabilirmi.Nasil bir yol izlemem gerekiyor.
Bu konuda yardimci olursaniz cok sevinirim
Teşekkürler

Sub Pdf ()
Dim i As Integer​
Dim WShel As Object​


basla = Timer​
Set WShel = CreateObject("WScript.Shell")​


Const MsgText = "Dosyalar İndirilsin mi ?"​
Const MsgHdr = "İnidiriliyor..."​
If MsgBox(MsgText, vbYesNo Or vbMsgBoxRtlReading Or vbExclamation, MsgHdr) _​
= vbYes Then​
For i = 2 To 100​
Cells(i, "E").Value = Right(Cells(i, "A"), 4)​
URL$ = Cells(i, "A").Value​
dosya$ = "C:\Users\Tat\Desktop\Tat Download\" & Cells(i, 6).Value​
DownloadFile URL$, dosya$​

Next i​
End If​

bitir = Timer - basla​
MsgBox "İndirme işlemi " & Format(bitir, "00:00:00.00") & " süresinde tamamlanmıştır. ", _​
vbInformation + vbMsgBoxRtlReading​
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​
Kullanıcı avatarı
makss123
 
Kayıt: 11 Mar 2019 21:23
Meslek: MÜHENDİS
Yaş: 28
İleti: 1
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: ankara

Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: ASYAASYA ve 1 misafir

Bumerang - Yazarkafe