Страницы: 1
RSS
VBA цикл загрузки с URL
 
Код
Sub GetTheText()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    With CreateObject("internetexplorer.application")
        .Navigate sURL
             text = .Document.getElementsByClassName("container")(0).outerText
        .Quit
    End With

    ws.Cells(1, 1).Value = text
End Sub

Добрый день,

Выше код, все работает. Но как заполнить ячейки столбца по нахождению всех элементов класса container?
Изменено: VVR - 11.07.2020 10:16:03
 
Код
Sub GetTheTextNontainer()

    Dim i As Integer
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    i = 0


Set IE = CreateObject("InternetExplorer.Application"):    
    On Error Resume Next
    'URLs = Range("A1")    
IE.Navigate URLs    
While IE.busy Or (IE.readyState <> 4): DoEvents: Wend   
    Sleep 1000
    Do While i < 100
    text = IE.Document.getElementsByClassName("container cleared")(i).outerText
    
    ws.Cells(i + 1, 1).Value = text

    i = i + 1
    
    ws.Cells(1, 2).Value = i
    
   Loop
     
End Sub


Нужно начинать с 1

Но загрузка, капц, долгая. И в конце выходит с ошибкой. Как определить последний элемент "container" и закончить обработку?
Сontainer составное число в текстовом формате, можно ли его как-то разложить по ячейкам?

Наверное не логично каждый цикл грузить вебстраницу...
Изменено: VVR - 11.07.2020 14:09:37
 
Добрый день! Не пишите, пожалуйста, сообщения подряд - можно вернуться к первому сообщению и откорректировать.
Разбейте задачу на две:
  • отправить HTTP(S) запрос и в ответ получить документ - его можно присвоить переменной типа Object. Далее запросы уже не нужны
  • разобрать структуру документа
Владимир
 
Привет. Оптимизировал. При выполнении просит заменить данные, как это сделать в автоматическом режиме?
Код
Sub GetTheTextContainer()

    Dim i As Integer
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    i = 0


Set IE = CreateObject("InternetExplorer.Application"):     
    On Error Resume Next
    'URLs = Range("A1")    
    IE.Navigate URLs 
    While IE.busy Or (IE.readyState <> 4): DoEvents: Wend    
    Sleep 1000
    Do While i < 100
    text = IE.Document.getElementsByClassName("container cleared")(i).outerText
    
    ws.Cells(i + 1, 1).Value = text

    i = i + 1
    
    ws.Cells(1, 2).Value = i
    
   Loop
     
     ThisWorkbook.Worksheets("Sheet1").Range("A1:A100").Select
        Selection.TextToColumns Destination:=ActiveCell.Offset(0, 3).Range("A1"), _
        DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=False _
        , Tab:=False, Semicolon:=False, Comma:=False, Space:=True, Other:= _
        False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1 _
        ), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
     
End Sub

Изменено: VVR - 11.07.2020 15:08:56
 
Что имеется в виду под такой конструкцией:
Код
Destination:=ActiveCell.Offset(0, 3).Range("A1")

Вопрос о замене данных говорит, скорее всего, о том, что макрос меняет какие-то непустые ячейки. Очистите эти ячейки до применения метода TextToColumns.
Изменено: sokol92 - 11.07.2020 16:25:24
Владимир
 
Странное дело, дружище.

текст по столбцам из скрипта работает только при активном Sheet1. Что-то у меня оба полушария вошли в клинч... пока нет идей.
 

Во-первых, не надо использовать

Цитата
VVR написал:
ThisWorkbook.Worksheets("Sheet1")
вы же уже присвоили переменной ws это.

Во-вторых, не понятно зачем вы в цикле присваиваете ячейке B1 значение i

Цитата
VVR написал:
ws.Cells(1, 2).Value = i
Я не вижу где это используется

В-третьих, зачем использовать функцию, которая предназначена для загрузки из текстовых файлов? Вы же помещаете данные в самом файле Excel.

Изменено: Иванов Вадим - 12.07.2020 11:05:09
 
Цитата
VVR написал:
из скрипта работает только при активном Sheet1
ага. Потому что Вы используете обращение именно к Selection, а не к конкретному листу
Цитата
VVR написал:
ThisWorkbook.Worksheets("Sheet1").Range("A1:A100").Select
вот это выдаст ошибку, если активен не Sheet1 на момент выполнения кода. Потому что невозможно выделить ячейки на неактивном листе.
Правильнее было бы так:
Код
ThisWorkbook.Worksheets("Sheet1").Range("A1:A100").TextToColumns Destination:=ThisWorkbook.Worksheets("Sheet1").Range("D1"), _
        DataType:=xlDelimited, TextQualifier:=xlNone, ConsecutiveDelimiter:=False _
        , Tab:=False, Semicolon:=False, Comma:=False, Space:=True, Other:= _
        False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1 _
        ), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True

Настоятельно рекомендую ознакомиться:
Как обратиться к диапазону из VBA
Select и Activate - зачем нужны и нужны ли?
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Код
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub GetTheTextContainer()

    Dim i As Integer
    Dim TWW As Worksheet: Set TWW = ThisWorkbook.Worksheets("Sheet1")
    Dim text As String

    i = 0
    TWW.Range("D1:J50").ClearContents


Set IE = CreateObject("InternetExplorer.Application"):     ' çàãðóæàåì áðàóçåð Internet Explorer
    On Error Resume Next
    Adrs = Range("A51")    ' óêàçûâàåì àäðåñ ñàéòà (âåá-ñòðàíèöû íàõîäèòñÿ â «A1»), òåêñò êîòîðîé çàãðóæàåì
    IE.Navigate Adrs    ' çàãðóæàåì ñàéò
    While IE.busy Or (IE.readyState <> 4): Sleep 1000: DoEvents: Wend    ' æäåì, ïîêà çàãðóçèòñÿ ñòðàíèöà
    Sleep 1000
    Do While i < 50
    text = IE.Document.getElementsByClassName("container")(i).outerText
    
    TWW.Cells(i + 1, 1).Value = text
    TWW.Cells(52, 1).Value = i
    Sleep 10
    i = i + 1      
Loop
          
        TWW.Range("A1:A50").TextToColumns Destination:=TWW.Range("D1:J50"), _
        DataType:=xlDelimited, TextQualifier:=xlNone, Space:=True, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1 _
        ), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
     
     Application.DeleteObject ("InternetExplorer.Application")
     Application.CutCopyMode = False
     
End Sub

Такой код получился.
Но:
1. Будет ли работать DeleteObject, что-то не пойму, в трее приложения (исправил) висят, и нагрузка на процессор растет. Как очистить память? -РЕШЕНО-
2. Все равно просит подтверждения замены данных, хотя ячейки пустые. -РЕШЕНО-
3. Возможно срау стоит разбивать и ложить в ячейки значения.
Страницы: 1
Наверх