VBA Получить одну или несколько ссылок из Интернета (из ячеек)

Question

Мне нужно это для моей работы.Кто-то написал нам макрос.Этот макрос содержит модуль, который берет ссылки из ячеек и загружает файлы.Тем не мение.Проблема в том, что это должно быть 2 строки или более, которые содержат ссылки.Это нонсенс для меня / нас, так как мы часто просто скачиваем одну ссылку / файл = только 1 строку.

Таким образом, код должен иметь возможность обрабатывать одну строку и несколько строк.

Я могу немного кодировать HTML и PHP, но это довольно давно.

Я понимаю, что ошибка "Subscript out of range" (= ext = buf (UBound (buf))) вызвана массивом.Или способ обработки массива.Но это все.

Если честно, у меня недостаточно времени, чтобы изучить VBA, чтобы исправить это.У меня также есть доступ к этим файлам только на работе ... и здесь, на работе ... Я должен работать LOL.

Итак, помощь будет высоко оценена.

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

Редактировать:

Снимок экрана макета листа Excel

Answer 1

Трудно сказать, не зная / не видя макета листа.

Я предполагаю / предполагаю, что строка 1 рабочего листа Links содержит заголовки и что сами данные (которые вы хотитецикличность) начинается со строки 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).т.е. один ряд данных).

Answer 2

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)"

Кажется, это устанавливает все гиперссылок на URL ячейки E2, то есть на тот же URL.

Функция GetURL является пользовательской функцией.См http://howtouseexcel.net/how-to-extract-a-url-from-a-hyperlink-on-excel