Как открыть гиперссылку на листе и сохранить папку с изображениями

Question

Как открыть гиперссылки на листе и сохранить каждое изображение в отдельной папке?

Я работаю в Excel. У меня 7 листов по 1000 записей каждый.

На каждом листе есть восемь столбцов гиперссылок (URL-адрес гиперссылки содержит ссылки на изображения). Гиперссылка каждой записи должна открываться в отдельных окнах.

Прямо сейчас я использую этот скрипт, чтобы открыть все гиперссылки одновременно.

Sub OpenHyperLinks()
'Update 20141124
    Dim xHyperlink As Hyperlink
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    For Each xHyperlink In WorkRng.Hyperlinks
        xHyperlink.Follow
    Next
End Sub

Я могу открыть все гиперссылки одновременно, но я действительно хочу открыть отдельные окна Chrome для каждой строки / записи, чтобы я мог сохранить изображение каждой записи в отдельных папках.

Смотрите следующее изображение. Я хочу открыть запись 10 в одном окне, 11 в другом окне и так далее.

Answer 1

Попробуйте этот код. Он работал на моей Windows 7 64-битной версии Chrome 62.0.3202.75.

Обычно Chrome открывает последующие URL-адреса в новой вкладке, а не в новом окне. Таким образом, вы не сможете контролировать это поведение, если используете Hyperlink.Follow методу в вашем VBA. Уловка заключается в том, чтобы вызывать новый экземпляр Chrome с помощью функции Shell после обработки каждой строки, чтобы последующие URL-адреса открывались в этом новом экземпляре и так далее.

Хотя этот код работал с моей стороны, он может или не может работать точно так, как ожидалось, в зависимости от версий ОС Windows /Chrome и способа его разработки. Так что попробуйте и доложите.

Более того, использование Shell может немного ускорить открытие URL-адреса, и самое главное, что Chrome все равно откроет действительный текстовый URL-адрес, даже если он на самом деле не разрешен как URL-адрес в документе Excel.

  Sub OpenHyperLinks()
    On Error Resume Next
    Dim xHyperlink As String
    Dim WorkRng As Range
    Dim cell As Range
    Dim counter As Integer
    Dim col_counter As Integer
    Dim row_counter As Integer
    Dim pHandle
    Const Chrome_Path = "C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe"
    'Set above Constant Chrome_Path to match  Chrome.exe location on your PC
    counter = 0
    row_counter = 0
    Set WorkRng = Application.InputBox("Select Range", Type:=8)
    If WorkRng.Rows.Count = 0 Then
        Exit Sub
    End If
    col_counter = WorkRng.Columns.Count
    For Each cell In WorkRng
        If counter = 0 Then
            pHandle = Shell(Chrome_Path)
        End If
        xHyperlink = cell.Value
        If xHyperlink = "" Then
        Else
            pHandle = Shell(Chrome_Path & " -url " & xHyperlink)
        End If
        counter = counter + 1
        If counter = col_counter Then
           counter = 0
        End If
    Next
End Sub

В коде нет особой проверки. В случае, если вы отмените в InputBox, саб выход выходит, так как нечего обрабатывать, и если Гиперссылка пуста, она будет пропущена. Установите константу Chrome_Path в соответствии с местоположением Chrome.exe на вашем компьютере, на случай, если он установлен в другую папку / раздел на вашем компьютере.

Если вам нужно обработать сотни URL-адресов, это может в конечном итоге замедлить работу вашего ПК, так как несколько экземпляров Chrome должны занимать память. В качестве альтернативы вы можете сделать паузу после каждой записи, используя MsgBox или около того, и вручную закрыть открытый экземпляр Chrome после завершения работы с ним.