今天发现了个用EXCEL下载文件的实例,看起来很不错,收藏一下。

附件如下:xls

这是代码:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub downloads()
    Dim i As Integer
    Dim Path As String
    Dim str As String
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error Resume Next
    MkDir ThisWorkbook.Path & "Downloads"        '图片文件的存放目录
    Path = ThisWorkbook.Path & "Downloads"
    For i = 2 To Sheet1.Range("a65534").End(xlUp).Row
    'A列中存放着图片的文件路径 http://www.xxx.net/photo/xxxx.gif
    str = Sheet1.Range("a" & i)
    Set ie = CreateObject("Msxml2.XMLHTTP")
        ie.Open "GET", str, False
        ie.Send
        'str = ie.ResponseText
        '等待网页处理完成再运行下面的代码
        Do Until ie.ReadyState = 4
            DoEvents
        Loop
       With CreateObject("ADODB.Stream")
            .Type = 1
            .Open
            .write ie.Responsebody
            'B列存放着新的文件名
            .savetofile Path & Sheet1.Range("b" & i) & Right(str, 4), 2
            .Close
        End With
    Next
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

发表评论

共有 0 条评论