office交流網(wǎng)--QQ交流群號(hào)及微信交流群

Access培訓(xùn)群:792054000         Excel免費(fèi)交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

微信交流群(請(qǐng)用微信掃碼)

        

VB及VBA下載網(wǎng)上文件代碼且有進(jìn)度條顯示

2017-09-20 21:35:00
網(wǎng)絡(luò)未知
轉(zhuǎn)貼
6096
'添加 internet transfer control 6.0 和 windows commom controls 6.0
'form代碼:

Private Sub cmdGET_Click()
StartDownLoad txtURL
End Sub

Private Sub Form_Load()
savefile.Text = App.Path
End Sub

Private Sub StartDownLoad(ByVal Geturl As String)
Dim spo%, filename$
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(App.Path & "\download") Then Set f = fso.CreateFolder(App.Path & "\download")
spo = InStrRev(Geturl, "/")
filename = Right(Geturl, Len(Geturl) - spo) '獲取文件名
savefile.Text = App.Path & "\download" & filename
Inet1.Execute Geturl, "get"   '開始下載
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
'State = 12 時(shí),用 GetChunk 方法檢索服務(wù)器的響應(yīng)。
Dim vtData() As Byte
Select Case State
'...沒有列舉其它情況。
Case icError '11
'出現(xiàn)錯(cuò)誤時(shí),返回 ResponseCode 和 ResponseInfo。
vtData = Inet1.ResponseCode & ":" & Inet1.ResponseInfo
Case icResponseCompleted ' 12
Dim bDone As Boolean: bDone = False
'取得第一個(gè)塊。
vtData() = Inet1.GetChunk(1024, 1)
DoEvents
Open savefile.Text For Binary Access Write As #1     '設(shè)置保存路徑文件后開始保存
'獲取下載文件長(zhǎng)度
If Len(Inet1.GetHeader("Content-Length")) > 0 Then ProgressBar1.Max = CLng(Inet1.GetHeader("Content-Length"))

'循環(huán)分塊下載
Do While Not bDone
Put #1, Loc(1) + 1, vtData()
vtData() = Inet1.GetChunk(1024, 1)
DoEvents
ProgressBar1.Value = Loc(1)   '設(shè)置進(jìn)度條長(zhǎng)度
If Loc(1) >= ProgressBar1.Max Then bDone = True
Loop

Close #1
MsgBox "下載完成", vbInformation, "通知"
End Select

End Sub
分享
文章分類
聯(lián)系我們
聯(lián)系人: 王先生
Email: 18449932@qq.com
QQ: 18449932
微博: officecn01
移動(dòng)訪問(wèn)