Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 22.01.2020, 05:12   #1
Snekich
Форумчанин
 
Аватар для Snekich
 
Регистрация: 19.11.2011
Сообщений: 128
По умолчанию Загрузить данные с web страницы по списку ссылок

Помогите, пожалуйста, победить ошибки.

Написал код:
Код:
Sub Загрузка_данных()

        For I = 2 To 25 'перебираем все ссылки

    Sheets("Данные").Select
    
    ' очищаем страницу что бы ничего не мешало
    Cells.Select
        Selection.Delete Shift:=xlUp
        Range("A1").Select
        
    'загружаем данные с веб страницы в ексель
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & Sheets("Ссылки").Range("F" & I) _
        , Destination:=Range("$A$1"))
        .Name = _
        "Датафайл"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
    'копируем строчку с ИНН
    Range("A9").Select
    Selection.Copy
    Sheets("Ссылки").Range("G" & I).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
    'копируем строчку со ИНН второй организации (вдруг первый не подойдет)
    Sheets("Данные").Select
    Range("A15").Select
    Selection.Copy
    Sheets("Ссылки").Range("H" & I).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
   Next I
   
End Sub
Не могу победить две ошибки:
1)
начиная со строки .WebSelectionType = xlEntirePage выдает ошибку
run-time error 1004 "application-defined or object-defined error"

2) ругается на не которые длинные ссылки (хотя ссылки не такие уж и длинные)
run-time error 5 "invalid procedure call or argument"
на строку
With ActiveSheet.QueryTables.Add(Connect ion:= _
"TEXT;" & Sheets("Ссылки").Range("F" & I) _
, Destination:=Range("$A$1"))
Вложения
Тип файла: rar Поиск ИНН по списку.rar (21.4 Кб, 0 просмотров)
Нет ничего невозможного, главное верить в это.
Snekich вне форума Ответить с цитированием
Старый 22.01.2020, 12:17   #2
Snekich
Форумчанин
 
Аватар для Snekich
 
Регистрация: 19.11.2011
Сообщений: 128
По умолчанию

Частично причину первой ошибки вроде бы понял.
Строку
Код:
   With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Sheets("Ссылки").Range("F" & I), Destination:=Range("$A$1"))
заменил на строку
Цитата:
With ActiveSheet.QueryTables.Add(Connect ion:="URL;" & Sheets("Ссылки").Range("F" & I).Value, Destination:=Range("$A$1"))
Теперь ошибки нет, но данные в web не загружает...
Нет ничего невозможного, главное верить в это.
Snekich вне форума Ответить с цитированием
Старый 22.01.2020, 14:01   #3
Snekich
Форумчанин
 
Аватар для Snekich
 
Регистрация: 19.11.2011
Сообщений: 128
По умолчанию

Вроде бы заставил код работать)
Такая мелочь оказалась, а мозг чуть ни сломал в попытках разобраться)

Код:
Sub Макрос5()

Dim my_url As Range
For Each my_url In Sheets("Ссылки").Range("F1:F25")
With ActiveSheet.QueryTables.Add(Connection:="URL;" + my_url, Destination:=Range("$A$1"))
    
        .Name = "Датафайл"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
    '    .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = True
        .WebDisableRedirections = True
        .Refresh BackgroundQuery:=False
    End With
    
   ' тут код по копипасту ИНН
    
    Next
End Sub
Нет ничего невозможного, главное верить в это.
Snekich вне форума Ответить с цитированием
Старый 22.01.2020, 14:31   #4
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
'копируем строчку с ИНН
    Range("A9").Select
    Selection.Copy
    Sheets("Ссылки").Range("G" & I).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
не будет короче?
Код:
     Sheets("Ссылки").Range("G" & I).value = Range("A9").value
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как загрузить результат php скрипта без перезагрузки страницы? Metrologik PHP 2 30.05.2018 16:16
Получение всех ссылок со страницы nibufep Общие вопросы Delphi 4 19.08.2015 13:02
Загрузить данные из XML в ComboBox Smagulov85 Общие вопросы Delphi 2 03.04.2012 08:31
Загрузить картинку сразу с загрузкой страницы Форсировка HTML и CSS 5 17.01.2011 20:25
Загрузить файл без обновления страницы? denisov JavaScript, Ajax 0 24.05.2010 17:44