Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Kassandra
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Работа vba с html: собрать информацию с веб-страницы
 
#
03.08.2017 09:29:18
Прилагаю файл.

Игорь, ему уже помогали на этом форуме, поэтому он надеется на вас еще раз =)  
 
Перейти    
Работа vba с html: собрать информацию с веб-страницы
 
#
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
 
#
14.10.2015 16:31:06
не работает чего-то =(
подскажите куда именно вставить ваш код =)
Код
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 I = LBound(TablNoemptyColumns) To UBound(TablNoemptyColumns)

  If Not IsEmpty(Target.Parent.Cells(Target.Row, TablNoemptyColumns(I)).Value) And _
     Target.Parent.Cells(Target.Row, TablNoemptyColumns(I) - 2).Value <> "99A" Then


    OneOfValues = False

    For Each c In TablCode

      If c = Target.Parent.Cells(Target.Row, TablTargetColumns(I)).Value Then
      sumtrue = (Cells(Target.Row, 21).Value + Cells(Target.Row, 27).Value + Cells(Target.Row, 31).Value _
+ Cells(Target.Row, 35).Value) = Cells(Target.Row, 20).Value
 
If notEmpty And sumtrue Then

        OneOfValues = True

        Exit For

      End If

    Next c

    If OneOfValues Then

      notEmpty = True

      Exit For

    End If
 End If
  

Next


If notEmpty Then

                    
                    'Macro email

               '--------------------------------------------------------

               If OutlookOuvert = False Then o = Shell("Outlook", vbNormalNoFocus)
                Email_Subject = " DL  "
                Email_Send_From = "xxx@gmail.com"
                Email_Send_To = "pxxxx@gmail.com"
                Email_Cc = "prxxxx@gmail.com"
                Email_Bcc = "prukxxxx@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 & _
                             "TTL Retard: " & Format(Cells(Target.Row, 20), "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
 
Перейти    
Условия для отправки autoemail
 
#
14.10.2015 14:05:24
Здравствуйте, помогите, пожалуйста, добавить еще одно условие перед отправкой электронного письма =)
существующее условие: если колонки 21/25/29/33 равны 31/34/36/18/99, нужно добавить еще одно условие перед существующим.
Вот это: если сумма колонок 21+27+31+35 равна колонке 20
 
Перейти    
Условия для отправки autoemail
 
#
28.08.2015 16:36:35
=)
 
Перейти    
Условия для отправки autoemail
 
#
28.08.2015 16:00:19
да, правильно, в любой строке данной колонки
я бы приложило, но не вижу, как я могу это сделать

На данный момент, эта проблеиа решена. но теперь есть другие проблемы:
1. в теме письма всегда прописывается не то число, которое нужно. Нужно. что бы в теме письма было то число, которое вносится (31/18/36/34/99)
2. как сделать часть текста, который отправляется в письме, жирным шрифтом?
3. добавить еще одно условие: если в колонке 22 или 26 или 30 или 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 i = LBound(TablNoemptyColumns) To UBound(TablNoemptyColumns)
  If Not IsEmpty(Target.Parent.Cells(Target.Row, TablNoemptyColumns(i)).Value) Then
    OneOfValues = False
    For Each c In TablCode
      If c = Target.Parent.Cells(Target.Row, TablTargetColumns(i)).Value Then
        OneOfValues = True
        Exit For
      End If
    Next c
    If OneOfValues Then
      notEmpty = True
      Exit For
    End If
  End If
Next

If notEmpty Then
    
                'Macro email
               '--------------------------------------------------------
               If OutlookOuvert = False Then o = Shell("Outlook", vbNormalNoFocus)
                Email_Subject = " DL " & TablCode(i)
                Email_Send_From = "xxx@gmail.com"
                Email_Send_To = "xxx@gmail.com"
                Email_Cc = "xxx@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
 
Перейти    
Условия для отправки autoemail
 
#
28.08.2015 12:43:12
если в колонке 21 написано число 31 или 18 или 36 или 34 или 99 и колонка 24 - не пустая => отправить письмо
если в колонке 25 написано число 31 или 18 или 36 или 34 или 99 и колонка 28 - не пустая => отправить письмо
если в колонке 29 написано число 31 или 18 или 36 или 34 или 99 и колонка 32 - не пустая => отправить письмо
если в колонке 33 написано число 31 или 18 или 36 или 34 или 99 и колонка 36 - не пустая => отправить письмо  
 
Перейти    
Условия для отправки autoemail
 
#
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
 
Перейти    
Страницы: 1
Наверх