Code download file từ URL

vu_tuan_manh_linh · 21/12/16

Tôi sử dụng đoạn code sau (sưu tầm) để tải 1 file từ một đường dẫn Dropbox. Tuy nhiên, các file tải về đều có dung lượng giống nhau (lúc thì 570k, lúc thì 598k) và đều bị hỏng, không mở được file. Mọi người chỉ giúp nguyên nhân. Xin cảm ơn!

PHP:

Sub DownloadFile()
Dim FileName As String
Dim myURL As String
Dim i
myURL = "https://www.dropbox.com/s/bjjjiilkxj4g67y/14TCN%2012_2002_Cong%20trinh%20thuy%20loi%20-%20Xay%20va%20lat%20da%20-%20Thi%20cong%20va%20nghiem%20thu.pdf?dl=0"
    For i = 1 To Len(myURL)
        If Mid(myURL, i, 1) = "/" Then FileName = Right(myURL, Len(myURL) - i)
    Next
    FileName = Replace(FileName, "%20", " ")
    FileName = Replace(FileName, "%", " ")
    FileName = Left(FileName, Len(FileName) - 5)
    MsgBox FileName
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send
 
myURL = WinHttpReq.responseBody
If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile "E:\" & FileName, 2
    oStream.Close
End If
End Sub

Tôi đã cố gắng tìm các thiết lập của tài khoản dropbox để không giới hạn dung lượng file được tải, nhưng không thấy.

doveandrose · 21/12/16

Mã:

https://www.dropbox.com/s/bjjjiilkxj4g67y/14TCN%2012_2002_Cong%20trinh%20thuy%20loi%20-%20Xay%20va%20lat%20da%20-%20Thi%20cong%20va%20nghiem%20thu.pdf?dl=[COLOR=#ff0000][SIZE=6][B]1[/B][/SIZE][/COLOR]

Mã:

CreateObject("[COLOR=#ff0000][SIZE=4][B]MSXML2.ServerXMLHTTP[/B][/SIZE][/COLOR]")

vu_tuan_manh_linh · 21/12/16

doveandrose đã viết:

Mã:

https://www.dropbox.com/s/bjjjiilkxj4g67y/14TCN%2012_2002_Cong%20trinh%20thuy%20loi%20-%20Xay%20va%20lat%20da%20-%20Thi%20cong%20va%20nghiem%20thu.pdf?dl=[COLOR=#ff0000][SIZE=6][B]1[/B][/SIZE][/COLOR]

Mã:

CreateObject("[COLOR=#ff0000][SIZE=4][B]MSXML2.ServerXMLHTTP[/B][/SIZE][/COLOR]")

Cảm ơn doveandrose! Tôi đã thử và thành công!

vu_tuan_manh_linh · 21/12/16

Xin được hỏi thêm doveandrose, có cách thức nào nhanh hơn không? Code này tải 1 file hơn 600k mất thời gian 5s. Như vậy trung bình chỉ được 120k/s.

doveandrose · 21/12/16

vu_tuan_manh_linh đã viết:
Xin được hỏi thêm doveandrose, có cách thức nào nhanh hơn không? Code này tải 1 file hơn 600k mất thời gian 5s. Như vậy trung bình chỉ được 120k/s.

có thể liên hệ 2 nơi sau để tăng tốc :
Admin Dropbox
Author Internet Download Manager

Doveandrose không nằm trong danh sách này

vu_tuan_manh_linh · 21/12/16

doveandrose đã viết:
có thể liên hệ 2 nơi sau để tăng tốc :
Admin Dropbox
Author Internet Download Manager

Doveandrose không nằm trong danh sách này

Tôi đã thử với 1 file 5M, thời gian tải về cũng 5s. Thật kỳ lạ!!

Kiều Mạnh · 21/12/16

Bạn thử Hàm API xem sao....Nhưng API Folder là tiếng việt có dấu là tèo đó ...vậy phải Viết thêm code

vu_tuan_manh_linh · 21/12/16

kieu manh đã viết:
Bạn thử Hàm API xem sao....Nhưng API Folder là tiếng việt có dấu là tèo đó ...vậy phải Viết thêm code

Cảm ơn kieumanh! Tôi đã thử hàm API URLDownloadToFile, tốc độ cũng không cải thiện lắm. Tùy chọn 1 trong 2 cách vậy!

Kiều Mạnh · 21/12/16

vu_tuan_manh_linh đã viết:
Cảm ơn kieumanh! Tôi đã thử hàm API URLDownloadToFile, tốc độ cũng không cải thiện lắm. Tùy chọn 1 trong 2 cách vậy!

Bạn thử úp file lên Google xem ...mình thấy Google cho tốc độ nhanh đó

vu_tuan_manh_linh · 21/12/16

kieu manh đã viết:
Bạn thử úp file lên Google xem ...mình thấy Google cho tốc độ nhanh đó

Tôi đã thử với 1 đường dẫn share từ google:

PHP:

InpUrl = "https://drive.google.com/file/d/0B1pZxPHo-dmdQjRLUWtZV0ZtOFk/view?usp=sharing"
OutFilePath = "E:\Linh.pdf"

Tuy nhiên vẫn gặp lỗi file tải xuống bị hỏng. kieu manh chỉ giúp sửa đường dẫn như thế nào để file download không lỗi.

Kiều Mạnh · 21/12/16

vu_tuan_manh_linh đã viết:
Tôi đã thử với 1 đường dẫn share từ google:

PHP:

InpUrl = "https://drive.google.com/file/d/0B1pZxPHo-dmdQjRLUWtZV0ZtOFk/view?usp=sharing" OutFilePath = "E:\Linh.pdf"

Tuy nhiên vẫn gặp lỗi file tải xuống bị hỏng. kieu manh chỉ giúp sửa đường dẫn như thế nào để file download không lỗi.

Link Bạn cho ko phải là link tải trực Tiếp từ Google....Bạn phải lấy Link trực Tiếp ý

VD: link sau của Mình là link trực Tiếp ...Copy paste vào trình duyệt là nó lập tức tải file về ngay hay bấm vào link cũng vậy tải file về lập Tức
thử nha ....

https://docs.google.com/uc?export=download&id=0B7zWYlns0sLBc3prR3lBVXdTWnc

Cách lấy link thaipv có viết trong thớt Add-ins tạo menu tiếng việt có dấu cho Office đó
Xem bài #135 nhé ... Cách lấy link trực Tiếp Google

http://www.giaiphapexcel.com/forum/...enu-RibbonTiếng-Việt-Có-Dấu-Cho-Office/page14

vu_tuan_manh_linh · 21/12/16

kieu manh đã viết:
Link Bạn cho ko phải là link tải trực Tiếp từ Google....Bạn phải lấy Link trực Tiếp ý

VD: link sau của Mình là link trực Tiếp ...Copy paste vào trình duyệt là nó lập tức tải file về ngay hay bấm vào link cũng vậy tải file về lập Tức
thử nha ....

https://docs.google.com/uc?export=download&id=0B7zWYlns0sLBc3prR3lBVXdTWnc

Cách lấy link thaipv có viết trong thớt Add-ins tạo menu tiếng việt có dấu cho Office đó
Xem bài #135 nhé ... Cách lấy link trực Tiếp Google

http://www.giaiphapexcel.com/forum/...enu-RibbonTiếng-Việt-Có-Dấu-Cho-Office/page14

Cảm ơn kieumanh rất nhiều! Hóa ra tôi còn lơ mơ về mấy anh đám mây quá!

Kiều Mạnh · 21/12/16

vu_tuan_manh_linh đã viết:
Cảm ơn kieumanh rất nhiều! Hóa ra tôi còn lơ mơ về mấy anh đám mây quá!

Bạn thử code của bạn tải file của Mình nhé

Mã:

Sub DownloadFile()
    Dim FileName As String
    Dim myURL As String
    Dim i
    myURL = "https://docs.google.com/uc?export=download&id=0B7zWYlns0sLBc3prR3lBVXdTWnc"
        For i = 1 To Len(myURL)
            If Mid(myURL, i, 1) = "/" Then FileName = Right(myURL, Len(myURL) - i)
        Next
[COLOR=#ff0000]        FileName = Replace(FileName, "%20", " ")[/COLOR]
[COLOR=#ff0000]        FileName = Replace(FileName, "%", " ")[/COLOR]
[COLOR=#ff0000]        FileName = Left(FileName, Len(FileName) - 5)[/COLOR]
        ''MsgBox FileName
    Dim WinHttpReq As Object
    ''Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    Set WinHttpReq = CreateObject("MSXML2.ServerXMLHTTP")
    WinHttpReq.Open "GET", myURL, False, "username", "password"
    WinHttpReq.send
    myURL = WinHttpReq.responseBody
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        ''oStream.SaveToFile "E:\" & FileName, 2
        oStream.SaveToFile "E:\Tonghop_ABC.xlsb", 2
        oStream.Close
    End If
End Sub

Code đó thấy chậm hơn Hàm API ....Và Bạn xem lại chỗ màu đỏ xem

vu_tuan_manh_linh · 21/12/16

kieu manh đã viết:
Bạn thử code của bạn tải file của Mình nhé
Code đó thấy chậm hơn Hàm API ....Và Bạn xem lại chỗ màu đỏ xem

Ah, chỗ màu đỏ là khi tải file từ dropbox thì tôi lấy tên file lưu theo URL. Tôi đã thử code API và link google driver, thấy tốc độ cải thiện đáng kể. Dù sao thì tổng dữ liệu cần tải cũng chỉ khoảng 200M nên không thành vấn đề lắm. Nhân tiện xin được hỏi Kieumanh, code lấy lũy kế dung lượng tải xuống như thế nào ạ? Muốn làm thêm cái tiến trình tải cho có vẻ chuyên nghiệp chút! Tôi có kiếm được đoạn code này mà không hiểu biến lngDataReturned được gián giá trị ở đoạn nào nữa.

PHP:

Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetReadBinaryFile Lib "wininet.dll" Alias "InternetReadFile" (ByVal hfile As Long, ByRef bytearray_firstelement As Byte, ByVal lNumBytesToRead As Long, ByRef lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
 
Sub DownloadFile(sUrl As String, filePath As String, Optional overWriteFile As Boolean)
  Dim hInternet, hSession, lngDataReturned As Long, sBuffer() As Byte, totalRead As Long
  Const bufSize = 128
  ReDim sBuffer(bufSize)
  hSession = InternetOpen("", 0, vbNullString, vbNullString, 0)
  If hSession Then hInternet = InternetOpenUrl(hSession, sUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
  Set oStream = CreateObject("ADODB.Stream")
  oStream.Open
  oStream.Type = 1
 
  If hInternet Then
    iReadFileResult = InternetReadBinaryFile(hInternet, sBuffer(0), UBound(sBuffer) - LBound(sBuffer), lngDataReturned)
    ReDim Preserve sBuffer(lngDataReturned - 1)
    oStream.Write sBuffer
    ReDim sBuffer(bufSize)
    totalRead = totalRead + lngDataReturned
    Application.StatusBar = "Downloading file. " & CLng(totalRead / 1024) & " KB downloaded"
    DoEvents
 
    Do While lngDataReturned <> 0
      iReadFileResult = InternetReadBinaryFile(hInternet, sBuffer(0), UBound(sBuffer) - LBound(sBuffer), lngDataReturned)
      If lngDataReturned = 0 Then Exit Do
 
      ReDim Preserve sBuffer(lngDataReturned - 1)
      oStream.Write sBuffer
      ReDim sBuffer(bufSize)
      totalRead = totalRead + lngDataReturned
      Application.StatusBar = "Downloading file. " & CLng(totalRead / 1024) & " KB downloaded"
      DoEvents
    Loop
 
    Application.StatusBar = "Download complete"
    oStream.SaveToFile filePath, IIf(overWriteFile, 2, 1)
    oStream.Close
  End If
  Call InternetCloseHandle(hInternet)
End Sub

Kiều Mạnh · 21/12/16

vu_tuan_manh_linh đã viết:

Ah, chỗ màu đỏ là khi tải file từ dropbox thì tôi lấy tên file lưu theo URL. Tôi đã thử code API và link google driver, thấy tốc độ cải thiện đáng kể. Dù sao thì tổng dữ liệu cần tải cũng chỉ khoảng 200M nên không thành vấn đề lắm. Nhân tiện xin được hỏi Kieumanh, code lấy lũy kế dung lượng tải xuống như thế nào ạ? Muốn làm thêm cái tiến trình tải cho có vẻ chuyên nghiệp chút! Tôi có kiếm được đoạn code này mà không hiểu biến lngDataReturned được gián giá trị ở đoạn nào nữa.

PHP:

Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetReadBinaryFile Lib "wininet.dll" Alias "InternetReadFile" (ByVal hfile As Long, ByRef bytearray_firstelement As Byte, ByVal lNumBytesToRead As Long, ByRef lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
 
Sub DownloadFile(sUrl As String, filePath As String, Optional overWriteFile As Boolean)
  Dim hInternet, hSession, lngDataReturned As Long, sBuffer() As Byte, totalRead As Long
  Const bufSize = 128
  ReDim sBuffer(bufSize)
  hSession = InternetOpen("", 0, vbNullString, vbNullString, 0)
  If hSession Then hInternet = InternetOpenUrl(hSession, sUrl, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0)
  Set oStream = CreateObject("ADODB.Stream")
  oStream.Open
  oStream.Type = 1
 
  If hInternet Then
    iReadFileResult = InternetReadBinaryFile(hInternet, sBuffer(0), UBound(sBuffer) - LBound(sBuffer), lngDataReturned)
    ReDim Preserve sBuffer(lngDataReturned - 1)
    oStream.Write sBuffer
    ReDim sBuffer(bufSize)
    totalRead = totalRead + lngDataReturned
    Application.StatusBar = "Downloading file. " & CLng(totalRead / 1024) & " KB downloaded"
    DoEvents
 
    Do While lngDataReturned <> 0
      iReadFileResult = InternetReadBinaryFile(hInternet, sBuffer(0), UBound(sBuffer) - LBound(sBuffer), lngDataReturned)
      If lngDataReturned = 0 Then Exit Do
 
      ReDim Preserve sBuffer(lngDataReturned - 1)
      oStream.Write sBuffer
      ReDim sBuffer(bufSize)
      totalRead = totalRead + lngDataReturned
      Application.StatusBar = "Downloading file. " & CLng(totalRead / 1024) & " KB downloaded"
      DoEvents
    Loop
 
    Application.StatusBar = "Download complete"
    oStream.SaveToFile filePath, IIf(overWriteFile, 2, 1)
    oStream.Close
  End If
  Call InternetCloseHandle(hInternet)
End Sub

Ồ cái món này là Anh ở bài #2 hay lắm đó ...Mạnh chưa Nghiên cứu Tới _)()(-

Code download file từ URL

vu_tuan_manh_linh

linhvtm84@gmail.com

doveandrose

hello

vu_tuan_manh_linh

linhvtm84@gmail.com

vu_tuan_manh_linh

linhvtm84@gmail.com

doveandrose

hello

vu_tuan_manh_linh

linhvtm84@gmail.com

Kiều Mạnh

I don't program, I beat code into submission!!!

vu_tuan_manh_linh

linhvtm84@gmail.com

Kiều Mạnh

I don't program, I beat code into submission!!!

vu_tuan_manh_linh

linhvtm84@gmail.com

Kiều Mạnh

I don't program, I beat code into submission!!!

vu_tuan_manh_linh

linhvtm84@gmail.com

Kiều Mạnh

I don't program, I beat code into submission!!!

vu_tuan_manh_linh

linhvtm84@gmail.com

Kiều Mạnh

I don't program, I beat code into submission!!!

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng