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

 

[quocphuoc88]

Góp them link ở trên Dropbox cho bạn nào cần: Sau khi lấy link share trên dropbox thì các link có số 0 đằng sau. Bạn chỉ việc đổi số 0 đó thành số 1 là ra drirect link !

 

[Kiều Mạnh]

Góp them link ở trên Dropbox cho bạn nào cần: Sau khi lấy link share trên dropbox thì các link có số 0 đằng sau. Bạn chỉ việc đổi số 0 đó thành số 1 là ra drirect link !

Bạn có biết lấy Link trực tiếp Google Drive không vây

 

[ndu96081631]

Bạn có biết lấy Link trực tiếp Google Drive không vây

Bạn cũng phải gửi thử một share link lên đây cho người ta nghiên cứu chứ

 

[Kiều Mạnh]

Bạn cũng phải gửi thử một share link lên đây cho người ta nghiên cứu chứ

Em gửi Anh Xem thế nào
https://drive.google.com/file/d/0B7zWYlns0sLBdElNTlVBRWc0NmM/view?usp=sharing

Code bài #4 Anh viết tải File link trực tiếp rất nhanh trên MediaFire ...nhưng kẹt một cái là link tải trực tiếp MediaFilre nó

hay thay đổi theo giờ ...Code Bài #18 viết xử lý lỗi đó oK nhưng tiếc 1 cái là xử lý tốc độ hơi chậm

Có cách nào kết hợp 2 code đó lại với nhau cho nó tải file nhanh được không Anh ...vì Em thấy điểu sử dụng phương thức sau ....

Set req = CreateObject("MSXML2.XMLHTTP")
    req.Open "GET", mfLink, False
    req.send 
    If req.Status = 200 Then

Em thấy nghiên cứu cái này thấy cũng hay....

 

[Kiều Mạnh]

Bạn cũng phải gửi thử một share link lên đây cho người ta nghiên cứu chứ

Em mới viết lại Hàm API ở bài 1 thêm Hàm DownloadFiles và kết hợp với code Bài #18 thì thấy tải File trực tiếp trên MediaFilre tốc độ rất nhanh ...còn thông Qua Hàm bài 18 tốc độ chậm lại ... vậy có cách nào xử được sự thay đổi của MediaFire nhanh như tải trực tiếp thì tuyệt Vời

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


Private Sub DownloadFiles(ByVal Url As String, FolderSave As String)
    ''Ham Nay Tai Link Truc Tiep Bieu Tuong DownLoad MediaFile [Chuot Phai Xong Chon Copy Link address]
    Dim DownloadFile As Long, FileName As String, FolderPath As String
    If Right(FolderSave, 1) <> "\" Then FolderSave = FolderSave & "\"
    FileName = Mid(Url, InStrRev(Url, "/") + 1, Len(Url))
    FolderPath = FolderSave & FileName
    DownloadFile = URLDownloadToFile(0, Url, FolderPath, 0, 0)
End Sub


Private Sub ChangeLink(ByVal Url As String, FolderSave As String)
    If Left(Url, 15) = "http://download" Then
        ''Link Truc Tiep Bieu Tuong DownLoad MediaFile [Chuot Phai Xong Chon Copy Link address]
        DownloadFiles Url, FolderSave
    Else ''Neu co Link truc Tiep Thi Xai API Tai cho Nhanh ... Neu Doi link thi xai ham sau
        GetMediafireUrlOnly Url, FolderSave      ''Link Tren Web ...www...
    End If
End Sub


Private Sub GetMediafireUrlOnly(ByVal mfLink As String, ByVal Folder2Save As String)
    Dim req As Object, lPos As Long, resp As String ''doveandrose
    Dim Ret As Long, FileName As String, FilePath As String
    Set req = CreateObject("MSXML2.XMLHTTP")
    req.Open "GET", mfLink, False
    req.send
    If req.Status = 200 Then
        resp = req.responseText
        lPos = InStr(resp, "http://download")
        resp = Mid(resp, lPos, InStr(lPos, resp, """") - lPos)
        If InStr(resp, "mediafire.com") > 0 Then
            DownloadFiles resp, Folder2Save
        Else
            MsgBox "rat' tiec' chuc' may man' lan` sau"
        End If
    End If
    Range("A20").Value = resp ''Link Truc Tiep Bieu Tuong DownLoad MediaFile [copy Link address]
    Set req = Nothing
End Sub


Sub Main_getMediafireUrlOnly()
    Dim Url As String, Folder2Save As String, TG As Double
    TG = Timer ''Link Tren Web MediaFire
    Url = "http://www.mediafire.com/download/3eckv2bmn7mvkvp/AutoClearTempFile.rar"
    Folder2Save = ThisWorkbook.path
    GetMediafireUrlOnly Url, Folder2Save
    MsgBox Format(Timer - TG, "0.000")
End Sub

Private Sub Main_DownloadFiles()
    Dim Url As String, Folder2Save As String, TG As Double
    TG = Timer ''Link truc tiep tren MediaFire
    Rem Link Truc Tiep Bieu Tuong DownLoad MediaFile [Chuot Phai Xong Chon Copy Link address]
    Url = Range("A20").Value
    Folder2Save = ThisWorkbook.path
    DownloadFiles Url, Folder2Save
    MsgBox Format(Timer - TG, "0.000")
End Sub

 

[Kiều Mạnh]

Mạnh mới tìm ra cách lấy link trực tiếp Google Drive ... Báo vậy nếu ai có hứng quan tâm thì mai mốt mạnh làm hướng dẫn ....

Link Google Drive sẻ không thay đổi Liên tục như MediaFire mà là link chết trừ khi Google sập hay chủ của nó xóa (thay đổi)

Sẻ ứng dụng nó làm lưu trữ cái gì đó ... và các máy có kết nối Internet có thể tải về sử dụng Vân vân và mây mây....

Ví dụ vào tải Google Drive thì Link sau

https://drive.google.com/file/d/0B7zWYlns0sLBdElNTlVBRWc0NmM/view

Còn Link trực tiếp là Vậy

http://googledrive.com/host/0B7zWYlns0sLBWFdvYkZ1dTB1cmc/AutoClearTempFile.rar


Sử dụng Code sau tải Link trực Tiếp hay code Anh Ndu viết OK tuốt

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


Private Sub DownloadFiles(ByVal Url As String, FolderSave As String)
    Dim DownloadFile As Long, FileName As String, FolderPath As String
    If Right(FolderSave, 1) <> "\" Then FolderSave = FolderSave & "\"
    FileName = Mid(Url, InStrRev(Url, "/") + 1, Len(Url))
    FolderPath = FolderSave & FileName
    DownloadFile = URLDownloadToFile(0, Url, FolderPath, 0, 0)
End Sub


Private Sub Main_GoogleDrive()
    Dim Url As String, Folder2Save As String, TG As Double
    TG = Timer
    Url = "http://googledrive.com/host/0B7zWYlns0sLBWFdvYkZ1dTB1cmc/AutoClearTempFile.rar"
    Folder2Save = ThisWorkbook.path
    DownloadFiles Url, Folder2Save
    MsgBox Format(Timer - TG, "0.000")
End Sub

 

[alias1313]

Em có vấn đề về download file muốn hỏi mong Thầy @ndu96081631 và các anh giúp đỡ:
-Em download 1 file trên web nội bộ của công ty để lấy thông số hàng ngày( được cập nhật 24h hàng ngày), sử dụng link down trực tiếp
+ Khi dùng code VBA download file về thì cột thông số 24h không có dữ liệu, các cột khác vẫn có thông số bình thường => ko lấy được thông số 24h
+ Nếu em sử dụng link trực tiếp đó add vào trình duyệt rồi download file về ( thủ công), thì cột 24h có thông số bình thường( thế mới kỳ)
+ Nếu em để sang ngày hôm sau chạy code VBA download file về thì file lại có thông số.
Xin giúp em!

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 = "a" & ".xls"
  path = Folder2Save & FileName
  Set objReq = CreateObject("MSXML2.XMLHTTP")
  objReq.Open "GET", URL, False
  objReq.send
  With objReq
  While Not .ReadyState = 4                               '<---------- wait
            Application.Wait Now + TimeValue("0:00:01")
        Wend
  If objReq.Status = 200 Then
  While InStr(1, .responseText, "Updating", 0) > 0    '<---------- wait again
                Application.Wait Now + TimeValue("0:00:03")
            Wend
            Debug.Print .responseText
 
    With CreateObject("ADODB.Stream")
      .Open
      .Type = 1
      .Write objReq.responseBody
      .Position = 0
      .SaveToFile path, 2
      .Close
    End With
  End If
     End With
  Set objReq = Nothing
End Sub
 Sub XL()
    Dim i As Variant
    Dim K1 As Variant
    Dim K2 As Variant
    Dim strPath2 As String
    Dim URL As String, Folder2Save As String
    Dim wbkWorkbook1 As Workbook
    Dim wbkWorkbook2 As Workbook
    Dim ngay As Date
    Dim ngay_c As Date
    Dim ngay1 As Variant
    Dim ngay2 As Variant
    Dim ngay3 As Variant
    Dim thang1 As Variant
    Dim nam1 As Variant
    Dim thang_c As Variant
    Dim nam As Variant
    Dim nam2 As Date
    Dim ngay_ts As Date
    Dim path_down As String
   
     ngay = Range("ngay_CT").Value
     ngay_c = Range("ngay_eom").Value
   
    If DatePart("d", ngay) < 10 Then
       ngay1 = "0" & DatePart("d", ngay)
    Else
        ngay1 = DatePart("d", ngay)
    End If
    If DatePart("m", ngay) < 10 Then
        thang1 = "0" & DatePart("m", ngay)
     Else
        thang1 = DatePart("m", ngay)
    End If
    nam = Year(ngay)
    nam1 = nam - Fix(nam / 10) * 10
    nam2 = Year(ngay_ts)
    thang_c = DatePart("m", ngay_c)
   
    If DatePart("m", ngay_c) < 10 Then
        thang_c = "0" & DatePart("m", ngay_c)
     Else
        thang_c = DatePart("m", ngay_c)
    End If
    ngay2 = ngay1 - 1
    ngay3 = DatePart("d", ngay_c)
    If DatePart("d", ngay) <= 10 Then
 
    ngay2 = "0" & ngay2
    Else
    ngay2 = ngay2
    End If
    path_down = Range("K39").Value & thang1 & "/" & ngay1 & "/" & nam & Range("K40").Value
   
  URL = path_down
  Folder2Save = ThisWorkbook.path
  URL2File URL, Folder2Save
  Application.ScreenUpdating = False
  strPath2 = ThisWorkbook.path & "\a.xls"
 
  Set wbkWorkbook1 = ThisWorkbook
  Set wbkWorkbook2 = Workbooks.Open(strPath2)
 ' làm gì đó với file open
 wbkWorkbook2.Close savechanges:=False
     
 GL
 

End Sub

Private Sub GL()
    Dim i As Variant
    Dim K1 As Variant
    Dim K2 As Variant
    Dim strPath2 As String
    Dim URL As String, Folder2Save As String
    Dim wbkWorkbook1 As Workbook
    Dim wbkWorkbook2 As Workbook
    Dim ngay As Date
    Dim ngay_c As Date
    Dim ngay1 As Variant
    Dim ngay2 As Variant
    Dim ngay3 As Variant
    Dim thang1 As Variant
    Dim nam1 As Variant
    Dim thang_c As Variant
    Dim nam As Variant
    Dim nam2 As Date
    Dim ngay_ts As Date
    Dim path_down As String
        ngay = Range("ngay_CT").Value
    ngay_c = Range("ngay_eom").Value
   
    If DatePart("d", ngay) < 10 Then
       ngay1 = "0" & DatePart("d", ngay)
    Else
        ngay1 = DatePart("d", ngay)
    End If
    If DatePart("m", ngay) < 10 Then
        thang1 = "0" & DatePart("m", ngay)
     Else
        thang1 = DatePart("m", ngay)
    End If
    nam = Year(ngay)
    nam1 = nam - Fix(nam / 10) * 10
    nam2 = Year(ngay_ts)
    thang_c = DatePart("m", ngay_c)
   
    If DatePart("m", ngay_c) < 10 Then
        thang_c = "0" & DatePart("m", ngay_c)
     Else
        thang_c = DatePart("m", ngay_c)
    End If
    ngay2 = ngay1 - 1
    ngay3 = DatePart("d", ngay_c)
    If DatePart("d", ngay) <= 10 Then
   
    ngay2 = "0" & ngay2
    Else
    ngay2 = ngay2
    End If
    path_down = Range("K39").Value & thang1 & "/" & ngay1 & "/" & nam & Range("K41").Value
   
  URL = path_down
  Folder2Save = ThisWorkbook.path
  URL2File URL, Folder2Save
  Application.ScreenUpdating = False
  strPath2 = ThisWorkbook.path & "\a.xls"
 
  Set wbkWorkbook1 = ThisWorkbook
  Set wbkWorkbook2 = Workbooks.Open(strPath2)

 
 
End Sub

 

[truongvu317]

Em có vấn đề về download file muốn hỏi mong Thầy @ndu96081631 và các anh giúp đỡ:
-Em download 1 file trên web nội bộ của công ty để lấy thông số hàng ngày( được cập nhật 24h hàng ngày), sử dụng link down trực tiếp
+ Khi dùng code VBA download file về thì cột thông số 24h không có dữ liệu, các cột khác vẫn có thông số bình thường => ko lấy được thông số 24h
+ Nếu em sử dụng link trực tiếp đó add vào trình duyệt rồi download file về ( thủ công), thì cột 24h có thông số bình thường( thế mới kỳ)
+ Nếu em để sang ngày hôm sau chạy code VBA download file về thì file lại có thông số.
Xin giúp em!

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 = "a" & ".xls"
  path = Folder2Save & FileName
  Set objReq = CreateObject("MSXML2.XMLHTTP")
  objReq.Open "GET", URL, False
  objReq.send
  With objReq
  While Not .ReadyState = 4                               '<---------- wait
            Application.Wait Now + TimeValue("0:00:01")
        Wend
  If objReq.Status = 200 Then
  While InStr(1, .responseText, "Updating", 0) > 0    '<---------- wait again
                Application.Wait Now + TimeValue("0:00:03")
            Wend
            Debug.Print .responseText
 
    With CreateObject("ADODB.Stream")
      .Open
      .Type = 1
      .Write objReq.responseBody
      .Position = 0
      .SaveToFile path, 2
      .Close
    End With
  End If
     End With
  Set objReq = Nothing
End Sub
 Sub XL()
    Dim i As Variant
    Dim K1 As Variant
    Dim K2 As Variant
    Dim strPath2 As String
    Dim URL As String, Folder2Save As String
    Dim wbkWorkbook1 As Workbook
    Dim wbkWorkbook2 As Workbook
    Dim ngay As Date
    Dim ngay_c As Date
    Dim ngay1 As Variant
    Dim ngay2 As Variant
    Dim ngay3 As Variant
    Dim thang1 As Variant
    Dim nam1 As Variant
    Dim thang_c As Variant
    Dim nam As Variant
    Dim nam2 As Date
    Dim ngay_ts As Date
    Dim path_down As String
   
     ngay = Range("ngay_CT").Value
     ngay_c = Range("ngay_eom").Value
   
    If DatePart("d", ngay) < 10 Then
       ngay1 = "0" & DatePart("d", ngay)
    Else
        ngay1 = DatePart("d", ngay)
    End If
    If DatePart("m", ngay) < 10 Then
        thang1 = "0" & DatePart("m", ngay)
     Else
        thang1 = DatePart("m", ngay)
    End If
    nam = Year(ngay)
    nam1 = nam - Fix(nam / 10) * 10
    nam2 = Year(ngay_ts)
    thang_c = DatePart("m", ngay_c)
   
    If DatePart("m", ngay_c) < 10 Then
        thang_c = "0" & DatePart("m", ngay_c)
     Else
        thang_c = DatePart("m", ngay_c)
    End If
    ngay2 = ngay1 - 1
    ngay3 = DatePart("d", ngay_c)
    If DatePart("d", ngay) <= 10 Then
 
    ngay2 = "0" & ngay2
    Else
    ngay2 = ngay2
    End If
    path_down = Range("K39").Value & thang1 & "/" & ngay1 & "/" & nam & Range("K40").Value
   
  URL = path_down
  Folder2Save = ThisWorkbook.path
  URL2File URL, Folder2Save
  Application.ScreenUpdating = False
  strPath2 = ThisWorkbook.path & "\a.xls"
 
  Set wbkWorkbook1 = ThisWorkbook
  Set wbkWorkbook2 = Workbooks.Open(strPath2)
 ' làm gì đó với file open
 wbkWorkbook2.Close savechanges:=False
     
 GL
 

End Sub

Private Sub GL()
    Dim i As Variant
    Dim K1 As Variant
    Dim K2 As Variant
    Dim strPath2 As String
    Dim URL As String, Folder2Save As String
    Dim wbkWorkbook1 As Workbook
    Dim wbkWorkbook2 As Workbook
    Dim ngay As Date
    Dim ngay_c As Date
    Dim ngay1 As Variant
    Dim ngay2 As Variant
    Dim ngay3 As Variant
    Dim thang1 As Variant
    Dim nam1 As Variant
    Dim thang_c As Variant
    Dim nam As Variant
    Dim nam2 As Date
    Dim ngay_ts As Date
    Dim path_down As String
        ngay = Range("ngay_CT").Value
    ngay_c = Range("ngay_eom").Value
   
    If DatePart("d", ngay) < 10 Then
       ngay1 = "0" & DatePart("d", ngay)
    Else
        ngay1 = DatePart("d", ngay)
    End If
    If DatePart("m", ngay) < 10 Then
        thang1 = "0" & DatePart("m", ngay)
     Else
        thang1 = DatePart("m", ngay)
    End If
    nam = Year(ngay)
    nam1 = nam - Fix(nam / 10) * 10
    nam2 = Year(ngay_ts)
    thang_c = DatePart("m", ngay_c)
   
    If DatePart("m", ngay_c) < 10 Then
        thang_c = "0" & DatePart("m", ngay_c)
     Else
        thang_c = DatePart("m", ngay_c)
    End If
    ngay2 = ngay1 - 1
    ngay3 = DatePart("d", ngay_c)
    If DatePart("d", ngay) <= 10 Then
   
    ngay2 = "0" & ngay2
    Else
    ngay2 = ngay2
    End If
    path_down = Range("K39").Value & thang1 & "/" & ngay1 & "/" & nam & Range("K41").Value
   
  URL = path_down
  Folder2Save = ThisWorkbook.path
  URL2File URL, Folder2Save
  Application.ScreenUpdating = False
  strPath2 = ThisWorkbook.path & "\a.xls"
 
  Set wbkWorkbook1 = ThisWorkbook
  Set wbkWorkbook2 = Workbooks.Open(strPath2)

 
 
End Sub

Bê đê? Một là thành công, hai là thất bại chứ không có cái kiểu đó. Đoán là link mà đưa vào vba và trình duyệt có vấn đề. Trình duyệt nó xử lý thông minh hơn nên rất khó đoán là nó download cái gì.

+Kiểm tra dung lượng 2 file.
+nếu dùng idm tgif kiểm tra xem idm nó bắt link nào?
+Noi chung bd là hơi bị căng vì không có cơ hội tiếp xúc hiện trường ( web nội bộ)

 

[alias1313]

Bê đê? Một là thành công, hai là thất bại chứ không có cái kiểu đó. Đoán là link mà đưa vào vba và trình duyệt có vấn đề. Trình duyệt nó xử lý thông minh hơn nên rất khó đoán là nó download cái gì.

+Kiểm tra dung lượng 2 file.
+nếu dùng idm tgif kiểm tra xem idm nó bắt link nào?
+Noi chung bd là hơi bị căng vì không có cơ hội tiếp xúc hiện trường ( web nội bộ)

- Dung lượng file là như nhau: 487kb
+ File download = code vba
+ File download = IDM
+ File download = Thủ công ( add link down vào trình duyệt)
=> Link download trực tiếp của 3 trường hợp trên là giống nhau, đã kiểm tra rất kỹ!

Mình nghĩ là có "kiểu đó": Nó kiểu như thông tin bị chặn hoặc chưa kịp load khi sử dụng code, nhưng do kiến thức tin học mình không có
nên không hiểu được. Code trên là học hỏi từ các anh trên Giaiphapexcel, và google rồi chỉnh lại theo nhu cầu mình cần.
+ Trước đây mình không dùng link trực tiếp, mà đăng nhập vào trang đó bằng tài khoản rồi lấy thông tin theo cấu trúc web( Scrape data from website)
nhưng dùng cách này lúc được lúc không, do nó bị thằng internet option(Protect mode) chặn dữ liệu, mình mò 2 tuần mới biết nguyên nhân, khi tùy chỉnh internet option thì nó
lấy đc dữ liệu, nhưng chạy đc vài lần, sau đó cứ tới phần đăng nhập ID là nó lỗi( thay ID khác chạy đc vài lần nó lại bị), tức là:
* tùy chỉnh cho đăng nhập đc thì dữ liệu lúc có lúc không
* tùy chỉnh để lấy đc dữ liệu(lúc nào cũng lấy đc dữ liệu) thì chạy vài lận nó lại lỗi đăng nhập

Cảm ơn bạn @truongvu317 đã giúp đỡ, năm mới chúc bạn cùng gia đình mạnh khỏe, mọi sự bình an! ( Avata đẹp quá..^_^)

 

[truongvu317]

487kb

Kiểm tra độ chính xác tới từng byte vào, xem nó bao nhiêu byte, chứ kb sẽ có sai số lớn lắm. Hay chuyển sang dùng vba điều khiển idm đi, idm tải xong thì ta chỉ việc đọc file, nếu file dung lượng lớn thì tuyệt trần đời luôn.

 

[alias1313]

Kiểm tra độ chính xác tới từng byte vào, xem nó bao nhiêu byte, chứ kb sẽ có sai số lớn lắm. Hay chuyển sang dùng vba điều khiển idm đi, idm tải xong thì ta chỉ việc đọc file, nếu file dung lượng lớn thì tuyệt trần đời luôn.

Mình có thể download trực tiếp trên trình duyệt, file dl về vẫn có thông số bình thường
+ IE: khi dùng IE dl nó hiện ra hộp thoại save file( ko chỉnh autosave được - xin giúp đỡ), cái này mình đang tìm cách để thao tác hộp thoại này bằng VBA.
+ Firefox: autosave đc, nhưng lại không biết cách để ẩn trình duyệt firefox khi chạy - xin giúp đỡ.
+ điều khiển IDM thì mình chịu, bạn có thể giúp mình không!
Đây là code mình viết đe download bằng Firefox với link trực tiếp:

Sub download()
 Dim Firefoxpath  As String

 Firefoxpath = "C:\Program Files\Mozilla Firefox\firefox.exe"

  Shell (Firefoxpath) & URL

  'URL = link down truc tiep
  strPath2 = "C:\Users\*"     ' thu muc chua file download, cai dat mac dinh tren trinh duyet FireFox
  Application.Wait (Now + TimeValue("00:00:02"))
 
  Set wbkWorkbook1 = ThisWorkbook
  Set wbkWorkbook2 = Workbooks.Open(strPath2)
  End Sub

Nhưng mình vẫn muốn làm theo cách đầu tiên và muốn tìm ra nguyên nhân tại sao dữ liệu lại bị thiếu khi download bằng cách đó ( chỉ thiếu khoảng 10 thông số, số thông số bị thiếu thay đổi ở mỗi lần dl, có khi 8,9..)

 

[truongvu317]

Mình có thể download trực tiếp trên trình duyệt, file dl về vẫn có thông số bình thường
+ IE: khi dùng IE dl nó hiện ra hộp thoại save file( ko chỉnh autosave được - xin giúp đỡ), cái này mình đang tìm cách để thao tác hộp thoại này bằng VBA.
+ Firefox: autosave đc, nhưng lại không biết cách để ẩn trình duyệt firefox khi chạy - xin giúp đỡ.
+ điều khiển IDM thì mình chịu, bạn có thể giúp mình không!
Đây là code mình viết đe download bằng Firefox với link trực tiếp:

Sub download()
 Dim Firefoxpath  As String

 Firefoxpath = "C:\Program Files\Mozilla Firefox\firefox.exe"

  Shell (Firefoxpath) & URL

  'URL = link down truc tiep
  strPath2 = "C:\Users\*"     ' thu muc chua file download, cai dat mac dinh tren trinh duyet FireFox
  Application.Wait (Now + TimeValue("00:00:02"))
 
  Set wbkWorkbook1 = ThisWorkbook
  Set wbkWorkbook2 = Workbooks.Open(strPath2)
  End Sub

Nhưng mình vẫn muốn làm theo cách đầu tiên và muốn tìm ra nguyên nhân tại sao dữ liệu lại bị thiếu khi download bằng cách đó ( chỉ thiếu khoảng 10 thông số, số thông số bị thiếu thay đổi ở mỗi lần dl, có khi 8,9..)

Muốn biết nguyên nhân chính xâc thì phải sờ vào hiện vật mới đoán được. Nhìn code thì chịu.

 

[batman1]

Em có vấn đề về download file muốn hỏi mong Thầy @ndu96081631 và các anh giúp đỡ:
-Em download 1 file trên web nội bộ của công ty để lấy thông số hàng ngày( được cập nhật 24h hàng ngày), sử dụng link down trực tiếp
+ Khi dùng code VBA download file về thì cột thông số 24h không có dữ liệu, các cột khác vẫn có thông số bình thường => ko lấy được thông số 24h
+ Nếu em sử dụng link trực tiếp đó add vào trình duyệt rồi download file về ( thủ công), thì cột 24h có thông số bình thường( thế mới kỳ)
+ Nếu em để sang ngày hôm sau chạy code VBA download file về thì file lại có thông số.

Hơi bị khó hiểu. Thôi thì thử hơi khác.
1. Xóa code Sub URL2File của bạn
2. Tải tập tin đính kèm và bung vào 1 thư mục nào đấy.
3. Mở tập tin Excel của bạn -> Alt + F11 -> menu File -> chọn Import File -> duyệt tới thư mục và chọn Module1.bas -> làm tương tự nhưng chọn clsXMLHTTPHandler.cls -> lưu tập tin.
4. Chạt code URL2File xem có được không.
5. Được hay không được thì tôi cũng kết thúc. Không có đường dẫn và không ở trong mạng nội bộ để nghiên cứu nên phải đoán mò. Mà tôi lại chưa học khóa đoán mò nào

 

[AutoReply]

Mà tôi lại chưa học khóa đoán mò nào

Chưa học không hẳn sẽ không làm được. Có những kỹ năng không cần phải qua khóa học. Đặc biệt là mò ( càng tối càng hấp dẫn...)

 

[batman1]

Chưa học không hẳn sẽ không làm được. Có những kỹ năng không cần phải qua khóa học. Đặc biệt là mò ( càng tối càng hấp dẫn...)

Tôi nói "đoán mò". Còn nếu là "mò" là "dò", là "sờ" thì phải thật tối mới nhiều cảm xúc. Trí tưởng tượng, xúc giác tha hồ bay bổng

 

[alias1313]

Tôi nói "đoán mò". Còn nếu là "mò" là "dò", là "sờ" thì phải thật tối mới nhiều cảm xúc. Trí tưởng tượng, xúc giác tha hồ bay bổng

Bác thật là...tuyệt....
Em vừa chạy thử để lấy công tơ 24h...hiện tại ...mọi thứ hoàn hảo....em đã lấy đc thông số mình cần,thông số hiện đầy đủ, không còn bị thiếu nữa!
Anh có thể cho em biết:
+ Tại sao thông số của em lại bị thiếu khi em chạy bằng code của em ko ạ
+ Và Code anh gửi cho em đã chỉnh phần nào mà thông số lại có đầy đủ ( Em nhìn code biết áp dụng, nhưng không hiểu hết)

Cảm ơn anh @batman1 , bạn @truongvu317 rất nhiều
Cảm ơn bạn @AutoReply đã ghé qua...^_^...

 

[batman1]

+ Tại sao thông số của em lại bị thiếu khi em chạy bằng code của em ko ạ
+ Và Code anh gửi cho em đã chỉnh phần nào mà thông số lại có đầy đủ ( Em nhìn code biết áp dụng, nhưng không hiểu hết)

Cái khác chính là bạn có

objReq.Open "GET", URL, False

Tức thông số thứ 3 = False
Còn tôi có

objReq.Open "GET", URL, True

Tức thông số thứ 3 = True

Về thông số thứ 3 thì bạn tự đọc

async Optional
An optional Boolean parameter, defaulting to true, indicating whether or not to perform the operation asynchronously. If this value is false, the send()method does not return until the response is received. If true, notification of a completed transaction is provided using event listeners. This must be true if the multipart attribute is true, or an exception will be thrown.
Note: Starting with Gecko 30.0 (Firefox 30.0 / Thunderbird 30.0 / SeaMonkey 2.27), synchronous requests on the main thread have been deprecated due to the negative effects to the user experience.

Chính vì thế tôi phục vụ sự kiện ReadyStateChange
Tức trong lớp clsXMLHTTPHandler có dòng

XmlHttpRequest.OnReadyStateChange = Me

Như thế thì khi sảy ra sự kiện OnReadyStateChange thì code callback sẽ được gọi. Để thiết lập EventCallback (trong class clsXMLHTTPHandler) là callback và sẽ được gọi thì phải có chút thủ thuật *. Chính vì thế mà tôi đính kèm tập tin clsXMLHTTPHandler.cls chứ không dâng cho bạn code ở dạng văn bản.
Trong EventCallback thì code kiểm tra ReadyState và Status của đối tượng. Nếu Status là 200 thì gọi sub SaveFile (được truyền khi gọi phương thức Send của đối tượng request) - dùng Application.Run. code của SaveFile sẽ ghi tập tin.

* Bạn không thể viết

XmlHttpRequest.OnReadyStateChange = Me.EventCallback

với hàm ý là code EventCallback sẽ phục vụ sự kiện OnReadyStateChange, để khi sự kiện OnReadyStateChange sảy ra thì code EventCallback sẽ được thực hiện. Vậy thì bằng cách nào "thông báo" là EventCallback chính là để phục vụ sự kiện OnReadyStateChange? Bằng cách cho EventCallback là thuộc tính mặc định của class clsXMLHTTPHandler. Nhưng cho bằng cách nào?
Bằng cách: sau khi có code của class clsXMLHTTPHandler thì chọn nó và từ menu File chọn Remove class clsXMLHTTPHandler -> chọn Yes để lưu lại clsXMLHTTPHandler.cls ở thư mục nào đó -> mở tập tin clsXMLHTTPHandler.cls vd. bằng notepad -> sau dòng Sub EventCallback() thì thêm 1 dòng

Attribute EventCallback.VB_UserMemId = 0

Bạn mở tập tin CLS của tôi thì sẽ thấy dòng thêm này.

-> lưu lại và đóng notepad -> menu File chọn Import -> chọn tập tin vừa sửa.

Như vậy thì EventCallback sẽ là mặc định và khi sảy ra sự kiện OnReadyStateChange thì mặc định của đối tượng được "đưa vào" OnReadyStateChange sẽ được gọi. Do ta có

XmlHttpRequest.OnReadyStateChange = Me

nên khi sảy ra OnReadyStateChange thì mặc định của Me, tức clsXMLHTTPHandler, sé được gọi. Mà mặc định của clsXMLHTTPHandler chính là EventCallback. Thế thôi.

 

[alias1313]

Cái khác chính là bạn có

objReq.Open "GET", URL, False

Tức thông số thứ 3 = False
Còn tôi có

objReq.Open "GET", URL, True

Tức thông số thứ 3 = True

Về thông số thứ 3 thì bạn tự đọc


Chính vì thế tôi phục vụ sự kiện ReadyStateChange
Tức trong lớp clsXMLHTTPHandler có dòng

XmlHttpRequest.OnReadyStateChange = Me

Như thế thì khi sảy ra sự kiện OnReadyStateChange thì code callback sẽ được gọi. Để thiết lập EventCallback (trong class clsXMLHTTPHandler) là callback và sẽ được gọi thì phải có chút thủ thuật *. Chính vì thế mà tôi đính kèm tập tin clsXMLHTTPHandler.cls chứ không dâng cho bạn code ở dạng văn bản.
Trong EventCallback thì code kiểm tra ReadyState và Status của đối tượng. Nếu Status là 200 thì gọi sub SaveFile (được truyền khi gọi phương thức Send của đối tượng request) - dùng Application.Run. code của SaveFile sẽ ghi tập tin.

* Bạn không thể viết

XmlHttpRequest.OnReadyStateChange = Me.EventCallback

với hàm ý là code EventCallback sẽ phục vụ sự kiện OnReadyStateChange, để khi sự kiện OnReadyStateChange sảy ra thì code EventCallback sẽ được thực hiện. Vậy thì bằng cách nào "thông báo" là EventCallback chính là để phục vụ sự kiện OnReadyStateChange? Bằng cách cho EventCallback là thuộc tính mặc định của class clsXMLHTTPHandler. Nhưng cho bằng cách nào?
Bằng cách: sau khi có code của class clsXMLHTTPHandler thì chọn nó và từ menu File chọn Remove class clsXMLHTTPHandler -> chọn Yes để lưu lại clsXMLHTTPHandler.cls ở thư mục nào đó -> mở tập tin clsXMLHTTPHandler.cls vd. bằng notepad -> sau dòng Sub EventCallback() thì thêm 1 dòng

Attribute EventCallback.VB_UserMemId = 0

Bạn mở tập tin CLS của tôi thì sẽ thấy dòng thêm này.

-> lưu lại và đóng notepad -> menu File chọn Import -> chọn tập tin vừa sửa.

Như vậy thì EventCallback sẽ là mặc định và khi sảy ra sự kiện OnReadyStateChange thì mặc định của đối tượng được "đưa vào" OnReadyStateChange sẽ được gọi. Do ta có

XmlHttpRequest.OnReadyStateChange = Me

nên khi sảy ra OnReadyStateChange thì mặc định của Me, tức clsXMLHTTPHandler, sé được gọi. Mà mặc định của clsXMLHTTPHandler chính là EventCallback. Thế thôi.

Em cảm ơn anh rất nhiều!

 

[alias1313]

Cái khác chính là bạn có

objReq.Open "GET", URL, False

Tức thông số thứ 3 = False
Còn tôi có

objReq.Open "GET", URL, True

Tức thông số thứ 3 = True

Về thông số thứ 3 thì bạn tự đọc


Chính vì thế tôi phục vụ sự kiện ReadyStateChange
Tức trong lớp clsXMLHTTPHandler có dòng

XmlHttpRequest.OnReadyStateChange = Me

Như thế thì khi sảy ra sự kiện OnReadyStateChange thì code callback sẽ được gọi. Để thiết lập EventCallback (trong class clsXMLHTTPHandler) là callback và sẽ được gọi thì phải có chút thủ thuật *. Chính vì thế mà tôi đính kèm tập tin clsXMLHTTPHandler.cls chứ không dâng cho bạn code ở dạng văn bản.
Trong EventCallback thì code kiểm tra ReadyState và Status của đối tượng. Nếu Status là 200 thì gọi sub SaveFile (được truyền khi gọi phương thức Send của đối tượng request) - dùng Application.Run. code của SaveFile sẽ ghi tập tin.

* Bạn không thể viết

XmlHttpRequest.OnReadyStateChange = Me.EventCallback

với hàm ý là code EventCallback sẽ phục vụ sự kiện OnReadyStateChange, để khi sự kiện OnReadyStateChange sảy ra thì code EventCallback sẽ được thực hiện. Vậy thì bằng cách nào "thông báo" là EventCallback chính là để phục vụ sự kiện OnReadyStateChange? Bằng cách cho EventCallback là thuộc tính mặc định của class clsXMLHTTPHandler. Nhưng cho bằng cách nào?
Bằng cách: sau khi có code của class clsXMLHTTPHandler thì chọn nó và từ menu File chọn Remove class clsXMLHTTPHandler -> chọn Yes để lưu lại clsXMLHTTPHandler.cls ở thư mục nào đó -> mở tập tin clsXMLHTTPHandler.cls vd. bằng notepad -> sau dòng Sub EventCallback() thì thêm 1 dòng

Attribute EventCallback.VB_UserMemId = 0

Bạn mở tập tin CLS của tôi thì sẽ thấy dòng thêm này.

-> lưu lại và đóng notepad -> menu File chọn Import -> chọn tập tin vừa sửa.

Như vậy thì EventCallback sẽ là mặc định và khi sảy ra sự kiện OnReadyStateChange thì mặc định của đối tượng được "đưa vào" OnReadyStateChange sẽ được gọi. Do ta có

XmlHttpRequest.OnReadyStateChange = Me

nên khi sảy ra OnReadyStateChange thì mặc định của Me, tức clsXMLHTTPHandler, sé được gọi. Mà mặc định của clsXMLHTTPHandler chính là EventCallback. Thế thôi.

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!

 

[batman1]

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!

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.