VBA从网站(从单元格)获取一个或多个链接

时间:2018-11-23 11:05:26

标签: excel vba excel-vba

我的工作需要这个。有人给我们写了一个宏。该宏包含一个模块,该模块从单元格获取链接并下载文件。 然而。问题是它必须是包含链接的2行或更多行。 这对我/我们来说都是胡说八道,因为我们经常只下载一个链接/文件=仅一行。

因此,代码必须能够处理单行和多行。

我可以编写一些HTML和PHP,但这已经很久了。

我了解到错误“下标超出范围”(= ext = buf(UBound(buf))) 是因为数组。或处理数组的方式。就是这样。

说实话,我没有足够的时间来学习VBA以解决此问题。我还只能在工作中访问这些文件...在这里工作...我必须工作。

因此,我们将非常感谢您的帮助。

Sub DownloadFilefromWeb()
    Dim strSavePath As String
    Dim URL As String, ext As String
    Dim buf, ret As Long
    Dim fi As String
    Dim lrow5 As Long
   Dim path As String

    Call Clear_All_Files_And_SubFolders_In_Folder
    lrow5 = Range("A2").End(xlDown).Row
    Worksheets("Link").Range("G2:G" & lrow5).Formula = "=GetURL(E2)"

    j = 1
    For i = 2 To lrow5
        fi = Worksheets("Link").Range("A" & i).Value
        URL = Worksheets("Link").Range("G" & i).Value
        buf = Split(URL, ".")
        ext = buf(UBound(buf))
        'MsgBox ActiveWorkbook.Path
        strSavePath = ActiveWorkbook.path & "\Backup\" & fi & "," & j & "." & ext
        ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
        j = j + 1
       'If ret = 0 Then
       '     MsgBox "Download has been succeed!"
       'Else
       '     MsgBox "Error"
       'End If

    Next i
  MsgBox ("Download Completed")
End Sub

编辑:

Screenshot of the excel sheet layout

2 个答案:

答案 0 :(得分:0)

lrow5 = Range("A2").End(xlDown).Row

这将从当前工作簿和工作表中获取行数。然后在循环中:

For i = 2 To lrow5

它从第二行开始。如果您希望它从第一行开始(并且只有一行),则将其更改为:

For i = 1 To lrow5


注意:我在这段代码中看不懂的是这行:

Worksheets("Link").Range("G2:G" & lrow5).Formula = "=GetURL(E2)"

似乎这会将 all 个超链接设置为单元格E2的URL,即 same URL。

GetURL函数是一个自定义函数。参见http://howtouseexcel.net/how-to-extract-a-url-from-a-hyperlink-on-excel

答案 1 :(得分:0)

不说/不知道图纸的布局就很难说。

我将猜测/假设Links工作表的第1行包含标题,并且数据本身(您要循环通过)从第2行开始。

Option Explicit

Sub DownloadFilefromWeb()
    Dim strSavePath As String
    Dim URL As String
    Dim ret As Long
    Dim Filename As String
    Dim fileExtension As String

    Call Clear_All_Files_And_SubFolders_In_Folder

    With Worksheets("Link")
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        .Range("G2:G" & lastRow).Formula = "=GetURL(E2)"

        Dim fileCount As Long
        fileCount = 1

        Dim rowIndex As Long
        For rowIndex = 2 To lastRow
            Filename = .Range("A" & rowIndex).Value
            URL = .Range("G" & rowIndex).Value
            fileExtension = VBA.Strings.Mid$(URL, VBA.Strings.InStrRev(URL, ".", -1, vbBinaryCompare))

            strSavePath = .Parent.path & "\Backup\" & Filename & "," & fileCount & fileExtension
            ret = URLDownloadToFile(0, URL, strSavePath, 0, 0) ' <- Don't seem to do anything with this value. Maybe include a MsgBox alert if it returns a non-zero value.

            fileCount = fileCount + 1
        Next rowIndex
    End With

    MsgBox ("Download Completed")
End Sub

主要区别在于lastRow是从工作表的最后一行向上分配的(以前是从第2行向下分配的,这意味着它永远不可能只是第2行,即一行数据)。