Code VBA Downloads File Từ Web Về Máy Tính

[Kiều Mạnh]

Hiện Mình đang sử dụng code sau của GPE Tải File từ Internet về hiên tại đang sử dụng tốt ...nhưng có một điều hơi bất tiện là mỗi lần thay đổi File tải về là phải sửa lại code ...cụ thể là sửa lại phần mở rộng của File VD như: *.rar, *.doc, *.xlsx, *.xlsb
Vì vậy mình úp lên nhờ các Bạn xem có cách nào khác mà chỉ nhập Link vào [B1] và chạy code là tải file về được không .... không cần biết file đó là Excel hay rar....
Code Downloads File

Private 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
Chạy Sub Này
Sub FileDownloads()
    Dim StrSavePath As String, Ret As Long
    StrSavePath = ThisWorkbook.Path & "\" & "FileDowloads.rar"    ''<- Ten File Luu
    Ret = URLDownloadToFile(0, [B1], StrSavePath, 0, 0)           ''<- Link Tai File Tai [B1]
End Sub

Xin Cảm Ơn Các Bạn

 

[NguyenNgocThuHien]

Anh ơi! có 1 vấn đề xảy ra moduel class: clsXMLHTTPHandler bị Kaspersky xác định là virus Heur:Trojan.script.generic nên khi em gửi báo cáo cho máy có Kaspersky nó xóa luôn file Excel. Khi em xóa moduel class: clsXMLHTTPHandler, thì máy nhận file bình thường! Mình có cách nào khắc phục vấn đề này ko anh! Mong anh @batman1 xem giúp em!

Em đoán là do cái câu lệnh sau:

If Len(pCallback) Then Application.Run pCallback, XmlHttpRequest.responseBody, pFile

Các chương trình anti virus nó rất để ý đến những câu lệnh khỏi chạy một cái gì đó, hãy tạm thời xóa bỏ ( chọn dòng đó rồi xóa đi), rồi thử xem antivirus có xóa file không, nếu nó không xóa thì tính cách thay thế câu lệnh đó, nếu nó xóa thì cứ thử xóa mấy câu lệnh nhạy cảm như createobject thay bằng new.

 

[alias1313]

Nếu Kaspersky đã quyết như vậy thì tôi cũng chịu không can thiệp được.
Bạn muốn nói là code của bạn ở bài #27 chạy bình thường, và Kaspersky cho phép? Bạn đã chạy code đó trên máy có Kaspersky chưa? Nếu Kaspersky cho phép code ở bài #27 mà lại chặn code ở bài #33 thì tôi chịu.

Tôi cũng chả bao giờ dùng Kaspersky nên không biết. Chỉ có một thời dùng duy nhất Zone Alarm, bây giờ thì cũng thôi dùng nó. Mọi dữ liệu quan trọng tôi đều có ở một thư mục luôn được ghi ra đĩa DVD. Khi system sụp đổ hoặc bị virus thì bung ghost ra thôi. Không chơi antivirus. Nhưng điều cần là không vào những nơi download game, không thăm những Cõi Thiên Thai.

Code chạy trên máy em bình thường( máy em không cài Kaspersky), nhưng khi gửi file excel(chứa code) qua máy có Kaspersky, nó xóa ngay trên mail luôn, ko đợi tải về nữa(mail outlook). em thử xóa moduel class: clsXMLHTTPHandler, thì máy có Kaspersky nhận bình thường. Khôn có cách nào khắc phục sao anh! Anh xem giúp em với.....^_^!

 

[batman1]

Ý tôi là làm y như nhau. Nếu bạn chỉ gửi thôi mà nó xóa thì bạn cũng thử gửi tập tin có code ở bài 1 của bạn xem nó có xóa không. Thế thôi.

Tôi mà gặp những phần mềm nào mà tự ý là tôi đá đít. Chặn? Ủng hộ cả 2 tay. Nhưng phải thông báo để người dùng quyết định bỏ chặn hay không. Ghi vào registry? Ủng hộ cả 2 tay nhưng phải hỏi ý kiến chủ máy. Thay đổi để tất cả các định dạng sẽ được mở bởi xyz? Hoan hô, nhưng phải hỏi và để người dùng tự quyết định. Máy của tôi thì tôi là người quyết định. Kiểu ngầm ngầm tự quyết thì đá đít.

 

[Kiều Mạnh]

xài lên windows10 đi xong đá đích mấy tay Kas hay Bkav đi cho nó gọn
nếu Win7 thì tải cái diệt Virus của bác Bill ấy về mà cài OK đó ....
Mấy năm nay tui chơi vậy ko bọn kia gặp Mạnh là có xu hướng thất nghiệp quá

 

[phuoclocvl]

Chào các anh,
có cách nào load từ đường dẫn như này không ?

https://www.ashleysupplier.com/ReportsNET/ReportCreator/ReportCreatorNETWaiting.aspx?Transfer=1

Cảm ơn nhìu ạ,

 

[befaint]

có cách nào load từ đường dẫn như này không ?
https://www.ashleysupplier.com/ReportsNET/ReportCreator/ReportCreatorNETWaiting.aspx?Transfer=1

Có dô được đâu mà loát?

 

[phuoclocvl]

Có dô được đâu mà loát?
View attachment 259808

dạ như này ạ

User: AS_900515_01
Pass: Heal1234

 

[befaint]

dạ như này ạ

User: AS_900515_01
Pass: Heal1234

Nó cứ như này mãi, không làm gì được. @@

 

[phuoclocvl]

Nó cứ như này mãi, không làm gì được. @@

View attachment 259824

Định mệnh thật, ko biết có cách nào load được bằng vba không các anh ơi. Giúp em với. Xin cảm ơn,

 

[anhtuan62]

Thấy code này viết dở ẹc! Ai rảnh sửa lại cho gọn và đẹp giùm cái...
Đọc code, thấy cái gì mà WorksheetFunction.Find rồi .Substitute... từa lưa hột dưa cả lên
(tay này hình như hổng biết hàm InStr và Replace trong VBA thì phải)
--------------
Còn tôi thì thích cái này hơn:

Private Sub URL2File(ByVal URL As String, ByVal Folder2Save As String)
  Dim objReq As Object
  Dim FileName As String, path As String
  If Right(Folder2Save, 1) <> "\" Then Folder2Save = Folder2Save & "\"
  FileName = Mid(URL, InStrRev(URL, "/") + 1, Len(URL))
  path = Folder2Save & FileName
  Set objReq = CreateObject("MSXML2.XMLHTTP")
  objReq.Open "GET", URL, False
  objReq.send
  If objReq.Status = 200 Then
    With CreateObject("ADODB.Stream")
      .Open
      .Type = 1
      .Write objReq.ResponseBody
      .Position = 0
      .SaveToFile path, 2
      .Close
    End With
  End If
  Set objReq = Nothing
End Sub

Ví dụ áp dụng để download 1 file, chẳng hạn là 1 file nhạc từ mp3.zing.vn:

Sub Test()
  Dim URL As String, Folder2Save As String
  URL = "http://stream2.hot2.cache11.vcdn.vn/fsfsdfdsfdserwrwq3/f89c6c4f2d64a98ce5dfdc06d81c89fb/558989f8/2011/07/08/d/c/dcf6ee06080c030069f791dd7d63857a.mp3"
  Folder2Save = ThisWorkbook.path
  URL2File URL, Folder2Save
End Sub

Xin thầy giúp em thêm phần đăng nhập vào web rồi mới tải file, làm tiếp code này luôn được không ạ, em cảm ơn.

 

[Kakama123]

Thấy code này viết dở ẹc! Ai rảnh sửa lại cho gọn và đẹp giùm cái...
Đọc code, thấy cái gì mà WorksheetFunction.Find rồi .Substitute... từa lưa hột dưa cả lên
(tay này hình như hổng biết hàm InStr và Replace trong VBA thì phải)
--------------
Còn tôi thì thích cái này hơn:

Private Sub URL2File(ByVal URL As String, ByVal Folder2Save As String)
  Dim objReq As Object
  Dim FileName As String, path As String
  If Right(Folder2Save, 1) <> "\" Then Folder2Save = Folder2Save & "\"
  FileName = Mid(URL, InStrRev(URL, "/") + 1, Len(URL))
  path = Folder2Save & FileName
  Set objReq = CreateObject("MSXML2.XMLHTTP")
  objReq.Open "GET", URL, False
  objReq.send
  If objReq.Status = 200 Then
    With CreateObject("ADODB.Stream")
      .Open
      .Type = 1
      .Write objReq.ResponseBody
      .Position = 0
      .SaveToFile path, 2
      .Close
    End With
  End If
  Set objReq = Nothing
End Sub

Ví dụ áp dụng để download 1 file, chẳng hạn là 1 file nhạc từ mp3.zing.vn:

Sub Test()
  Dim URL As String, Folder2Save As String
  URL = "http://stream2.hot2.cache11.vcdn.vn/fsfsdfdsfdserwrwq3/f89c6c4f2d64a98ce5dfdc06d81c89fb/558989f8/2011/07/08/d/c/dcf6ee06080c030069f791dd7d63857a.mp3"
  Folder2Save = ThisWorkbook.path
  URL2File URL, Folder2Save
End Sub

rất hay!. mình đã áp dụng thành công. sẵn đây cho mình hỏi, có cách nào để biết được kích thước file sắp dowload về hay không. và có cách nào để đọc được kích thước file đã tải về được bao nhiêu hay không bằng hàm này hoặc một hàm khác. vì mình muốn làm một cái progress bar cho người dùng theo dõi. mong được giúp đỡ