Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
цикл выгрузки данных с сайта
 
#1
20.04.2021 16:24:25
Всем доброго времени суток! Помогите пожалуйста. Нужно зациклить действие. Неделю бьюсь, не могу сообразить. :)
Есть лист, в нем: в столбце "A" логины в "B" пароли, количество может меняться (в районе 10-20). Макрос выгружает данные одного (первого) пользователя с корпоративного сайта и копирует данные на лист эксель. Нужно чтоб, он по очереди выгружал данные всех пользователей, и вставлял выгруженные данные на один лист отступая вниз или вправо. Заранее спасибо!)
Вот код:
Код
Sub FOBO()
Sheets("LOG").Select
    On Error Resume Next
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate "https://fobo-mon.corp.redit.ru/onlinesales"
    Application.Wait Now + TimeSerial(0, 0, 1)
    IE.Document.getelementbyID("in_username").Value = Sheets("LOG").Range("A1")
    IE.Document.getelementbyID("in_password").Value = Sheets("LOG").Range("b1")
    IE.Document.getelementbyID("btnpass").Click
    Application.Wait Now + TimeSerial(0, 0, 1)
    IE.Document.GetElementsByTagName("form")(0).submit
    Application.Wait Now + TimeSerial(0, 0, 2)
    Application.SendKeys "^a"
    Application.SendKeys "^c"
    IEe.Quit: Set IEe = Nothing
    Sheets("sales").Select
    Range("a1").Select
    ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
 End Sub
 
 
 
#2
20.04.2021 16:59:47
как-то так (но не тестировал)

Код
Sub FOBO()
Dim IE As Object
Dim LastRowLOG As Long, iRow As Long, LastRowSales As Long

    Sheets("LOG").Select
    LastRowLOG = Sheets("LOG").Cells(Rows.Count, 1).End(xlUp).Row 'номер последней заполненной ячейки на листе LOG в столбце А
    On Error Resume Next
    Set IE = CreateObject("InternetExplorer.Application")
    
    For iRow = 2 To LastRowLOG 'цикл со 2-й строки до последней
    
        Sheets("LOG").Select
        IE.Navigate "https://fobo-mon.corp.redit.ru/onlinesales"
        Application.Wait Now + TimeSerial(0, 0, 1)
        IE.Document.getelementbyID("in_username").Value = Sheets("LOG").Cells(iRow, 1) 'меняем строки в цикле
        IE.Document.getelementbyID("in_password").Value = Sheets("LOG").Cells(iRow, 2) 'меняем строки в цикле
        IE.Document.getelementbyID("btnpass").Click
        Application.Wait Now + TimeSerial(0, 0, 1)
        IE.Document.GetElementsByTagName("form")(0).submit
        Application.Wait Now + TimeSerial(0, 0, 2)
        Application.SendKeys "^a"
        Application.SendKeys "^c"
       
        Sheets("sales").Select
        LastRowSales = Sheets("sales").Cells(Rows.Count, 1).End(xlUp).Row 'номер последней заполненной ячейки на листе sales в столбце А
        Cells(LastRowSales + 3, 1).Select 'делаем отступ 2 строки (-1)
        ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
        
    Next iRow
        
    IEe.Quit: Set IEe = Nothing

    MsgBox "Конец", vbInformation, ""
 End Sub
 
 
 
#3
20.04.2021 18:13:28
Спасибо большое за оперативный ответ! Все работает!
 
 
 
#4
27.04.2021 09:11:36
Всем привет! А подскажите пожалуйста, ещё. Как мне, в этом же макросе уйти от sendkeys на копирование через intertext? Буду очень презнателен🙂
 
 
 
Страницы: 1
Наверх