Kassandra (Автор тем)

Работа vba с html: собрать информацию с веб-страницы

Пользователь

Сообщений: 8 Регистрация: 28.08.2015

02.08.2017 16:28:38

Здравствуйте, помогите, пожалуйста, моему другу из Франции =) перевожу, как поняла:

Привет,

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

На веб-странице есть два типа фильтра, но я не знаю, как это сделать в VBA, чтобы получить информацию с HTML.

- Первый фильтр (фото прилагается HTML часть 1 и 2), выпадающее меню, когда я нажимаю на элемент (фильтр), я получаю, то что изображено на первой картинке, когда я нажимаю на первую строчку в выпадающем меню, я получаю , то что изображено на второй картинке. Как сделать с помощью
VBA, чтобы автоматически нажмалось на H + 18

Код

<input name="ctl00$m$g_31a5f278_281c_49b2_a0c0_f8ec15187b13$ctl00$ddlTo" class="rcbInput"id="ctl00_m_g_31a5f278_281c_49b2_a0c0_f8ec15187b13_ctl00_ddlTo_Input" type="text" readOnly="readonly" value="HC+3h" autocomplete="off">

- Второй фильтр (фото filter 1 и 2) нужно, чтобы в белом поле (под словом Terminal) писалось заданное значение (эту часть я сделал), но после этого автоматически должно нажаться на кнопку справа(фильтр) и нажать на слово "CONTIENT"
* изображениt filter 1: когда я нажимаю посмотреть код страницы, я вижу этот код

Код

<input name="ctl00$m$g_31a5f278_281c_49b2_a0c0_f8ec15187b13$ctl00$rgVols$ctl00$ctl02$ctl02$Filter_Terminal" title="Filtre" class="rgFilter" id="ctl00_m_g_31a5f278_281c_49b2_a0c0_f8ec15187b13_ctl00_rgVols_ctl00_ctl02_ctl02_Filter_Terminal" onclick="$find("ctl00_m_g_31a5f278_281c_49b2_a0c0_f8ec15187b13_ctl00_rgVols"._showFilterMenu("ctl00_m_g_31a5f278_281c_49b2_a0c0_f8ec15187b13_ctl00_rgVols_ctl00", "Terminal", event); return false;__doPostBack('ctl00$m$g_31a5f278_281c_49b2_a0c0_f8ec15187b13$ctl00$rgVols$ctl00$ctl02$ctl02$Filter_Terminal','')" type="button" value=" ">

* изоброжение filter 2, когда я ищу слово, содержащееся в коде

Если кто может помочь, заранее спасибо =)

могу прикрепитьмой файл exele, если это может.

Файлы удалены: превышение допустимого размера вложения [МОДЕРАТОР]

Перейти

Условия для отправки autoemail

Kassandra

Пользователь

Сообщений: 8 Регистрация: 28.08.2015

14.10.2015 14:05:24

Здравствуйте, помогите, пожалуйста, добавить еще одно условие перед отправкой электронного письма =)
существующее условие: если колонки 21/25/29/33 равны 31/34/36/18/99, нужно добавить еще одно условие перед существующим.
Вот это: если сумма колонок 21+27+31+35 равна колонке 20

Перейти

Условия для отправки autoemail

Kassandra

Пользователь

Сообщений: 8 Регистрация: 28.08.2015

28.08.2015 11:53:26

Здравствуйте, помогите, пожалуйста, с написанием правильного кода.
Мне нужно что бы работали вот эти условия:
IF column 21 = 31 or 18 or 36 or 34 or 99 and Column 24 = не пустая => отправить письмо
IF column 25 = 31 or 18 or 36 or 34 or 99 and Column 28 = не пустая => отправить письмо
IF column 29 = 31 or 18 or 36 or 34 or 99 and Column 32 = не пустая => отправить письмо
IF column 33 = 31 or 18 or 36 or 34 or 99 and Column 36 = не пустая => отправить письмо
IF column 22 or 26 or 30 or 34 = 99A =>не отправлять письмо (если это условие невозможно прописать, то оно не сильно важно)

Вот мой код:

Код

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TablCode
Dim Email_Subject, Email_Send_From, Email_Send_To, _
   Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant

 TablCode = Array(31, 34, 36, 18, 99)
TablTargetColumns Array(21, 25, 29, 33)
TablNoemptyColumns Array(24, 28, 32, 36)

notEmpty = False
For Each c In TablNoemptyColumns
    If Not IsEmpty(Target.Parent.Cells(Target.Row, c).Value) Then
        notEmpty = True
        Exit For
    End If
Next
If InStr(Join(TablTargetColumns, " ") & " ", Target.Column & " ") > 0 And _
    InStr(Join(TablCode, " ") & " ", Target.Value & " ") > 0 And _
    notEmpty Then
    
                'Macro email
               '--------------------------------------------------------
               If OutlookOuvert = False Then o = Shell("Outlook", vbNormalNoFocus)
                Email_Subject = " DL " & TablCode(I)
                Email_Send_From = "xxxx@gmail.com"
                Email_Send_To = "xxxx@gmail.com"
                Email_Cc = "xxxx@gmail.com"
                Email_Bcc = "xxxx@gmail.com"
                Email_Body = "Auto-mail" & vbCr & _
                             "" & vbCr & _
                             "Un code " & " a été attribué à un vol aujourd'hui" & vbCr & _
                             vbCr & _
                             "Date : " & Cells(Target.Row, 1) & vbCr & _
                             "Nom agent: " & Cells(Target.Row, 2) & vbCr & _
                             "Vol Départ: " & Cells(Target.Row, 13) & vbCr & _
                             "STD: " & Format(Cells(Target.Row, 18), "hh:mm") & vbCr & _
                             "ATD: " & Format(Cells(Target.Row, 19), "hh:mm") & vbCr & vbCr & _
                             "DR1: " & Cells(Target.Row, 21) & vbCr & _
                             "Time: " & Format(Cells(Target.Row, 23), "hh:mm") & vbCr & _
                             "Explication: " & Cells(Target.Row, 24) & vbCr & vbCr & _
                             "DR2: " & Cells(Target.Row, 25) & vbCr & _
                             "Time: " & Format(Cells(Target.Row, 27), "hh:mm") & vbCr & _
                             "Explication: " & Cells(Target.Row, 28) & vbCr & vbCr & _
                             "DR3: " & Cells(Target.Row, 29) & vbCr & _
                             "Time: " & Format(Cells(Target.Row, 31), "hh:mm") & vbCr & _
                             "Explication: " & Cells(Target.Row, 32) & vbCr & vbCr & _
                             "DR4: " & Cells(Target.Row, 33) & vbCr & _
                             "Time: " & Format(Cells(Target.Row, 35), "hh:mm") & vbCr & _
                             "Explication: " & Cells(Target.Row, 36) & vbCr & vbCr & _
                             "@TT"
               
                On Error GoTo debugs
                Set Mail_Object = CreateObject("Outlook.Application")
                Set Mail_Single = Mail_Object.CreateItem(0)
                With Mail_Single
                    .Subject = Email_Subject
                    .To = Email_Send_To
                    .cc = Email_Cc
                    .BCC = Email_Bcc
                    .Body = Email_Body
                    .send
                End With
debugs:
                If Err.Description <> "" Then MsgBox Err.Description
                '----------------------------------------------------------------
           End If
End Sub

Перейти