Вытягиваю текст, но он без разделителей - т.е. подряд и цифра не ясна, в краце нужна вот эта табличка: даже не вся а нижняя часть, где кол-во отправлено и т.д. я логинюсь и нужные данные уже подставляю, но не могу получить их в нормальном виде. вот основной текст:
[vba]
Код
Function WebPageText(ByVal sURL, log, pass, edrpou As String, login As Boolean) As String On Error Resume Next Set IE = CreateObject("InternetExplorer.Application"): ' open Internet Explorer With IE '.Visible = True 'видимость .Navigate sURL ' переход While .Busy Or (.readyState <> 4): DoEvents: Wend ' ожидание Set ieDoc = .Document: DoEvents: DoEvents If ieDoc.Title Like "Ошибка сертификата*" Or ieDoc.Title Like "Certificate Error*" Then ieDoc.Links(1).Click While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend Set ieDoc = IE.Document End If
With ieDoc 'login If login = True Then Application.Wait (Now + TimeValue("0:00:01")) .getElementsByName("mylogin")(0).Value = log .getElementsByName("mypass")(0).Value = pass .getElementsByName("savepass")(0).Click '.getElementsByName("login")(0).Click '.getElementsByValue("submit")(0).Click .forms(0).submit While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend End If
.getElementsByName("group1")(0).Click .getElementsByName("edrpou")(0).Value = edrpou '.getElementsByName("im1")(0).Click .forms(0).submit While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend WebPageText = .body.innerText ' тянем
End With 'Application.Wait (Now + TimeValue("0:00:13"))
.Quit: Set IE = Nothing ' закрываем End With End Function
Вытягиваю текст, но он без разделителей - т.е. подряд и цифра не ясна, в краце нужна вот эта табличка: даже не вся а нижняя часть, где кол-во отправлено и т.д. я логинюсь и нужные данные уже подставляю, но не могу получить их в нормальном виде. вот основной текст:
[vba]
Код
Function WebPageText(ByVal sURL, log, pass, edrpou As String, login As Boolean) As String On Error Resume Next Set IE = CreateObject("InternetExplorer.Application"): ' open Internet Explorer With IE '.Visible = True 'видимость .Navigate sURL ' переход While .Busy Or (.readyState <> 4): DoEvents: Wend ' ожидание Set ieDoc = .Document: DoEvents: DoEvents If ieDoc.Title Like "Ошибка сертификата*" Or ieDoc.Title Like "Certificate Error*" Then ieDoc.Links(1).Click While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend Set ieDoc = IE.Document End If
With ieDoc 'login If login = True Then Application.Wait (Now + TimeValue("0:00:01")) .getElementsByName("mylogin")(0).Value = log .getElementsByName("mypass")(0).Value = pass .getElementsByName("savepass")(0).Click '.getElementsByName("login")(0).Click '.getElementsByValue("submit")(0).Click .forms(0).submit While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend End If
.getElementsByName("group1")(0).Click .getElementsByName("edrpou")(0).Value = edrpou '.getElementsByName("im1")(0).Click .forms(0).submit While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend WebPageText = .body.innerText ' тянем
End With 'Application.Wait (Now + TimeValue("0:00:13"))
.Quit: Set IE = Nothing ' закрываем End With End Function
Где- то я уже этот код видел. А не проще так сделать
[vba]
Код
Function WebPageText(ByVal sURL, log, pass, edrpou As String, login As Boolean) As String On Error Resume Next Set IE = CreateObject("InternetExplorer.Application"): ' open Internet Explorer With IE .Visible = True 'видимость .Navigate sURL ' переход While .Busy Or (.readyState <> 4): DoEvents: Wend ' ожидание Set ieDoc = .Document: DoEvents: DoEvents If ieDoc.Title Like "Ошибка сертификата*" Or ieDoc.Title Like "Certificate Error*" Then ieDoc.Links(1).Click While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend Set ieDoc = IE.Document End If If Len(edrpou) = 8 Then With ieDoc 'login If login = True Then Application.Wait (Now + TimeValue("0:00:01")) .getElementsByName("mylogin")(0).Value = log .getElementsByName("mypass")(0).Value = pass .getElementsByName("savepass")(0).Click '.getElementsByName("login")(0).Click '.getElementsByValue("submit")(0).Click .forms(0).submit While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend End If
.getElementsByName("group1")(0).Click .getElementsByName("edrpou")(0).Value = edrpou '.getElementsByName("im1")(0).Click .forms(0).submit While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend 'WebPageText = .Body.innerText ' тянем text WebPageText = .Body.innerHTML ' тянем HTML End With Application.Wait (Now + TimeValue("0:00:05")) Результат = Get_table(IE) ' получаем таблицу
Else MsgBox ("КОД НЕ 8ми ЗНАЧНЫЙ") End If .Quit: Set IE = Nothing ' закрываем End With End Function Function Get_table(IE) Dim S As String For Each aTable In IE.Document.GetElementsByTagName("table") If aTable.className = "sample2" Then For n = 1 To aTable.Rows.Length - 1 ' первую строку,а это заголовок,пропускаем For m = 0 To aTable.Rows(n).Cells.Length - 1 S = S & aTable.Rows(n).Cells(m).innertext & ";" Next S = S & vbCrLf Next End If Next Get_table = S End Function
[/vba]
Результат и есть ваша таблица без заголовка
Где- то я уже этот код видел. А не проще так сделать
[vba]
Код
Function WebPageText(ByVal sURL, log, pass, edrpou As String, login As Boolean) As String On Error Resume Next Set IE = CreateObject("InternetExplorer.Application"): ' open Internet Explorer With IE .Visible = True 'видимость .Navigate sURL ' переход While .Busy Or (.readyState <> 4): DoEvents: Wend ' ожидание Set ieDoc = .Document: DoEvents: DoEvents If ieDoc.Title Like "Ошибка сертификата*" Or ieDoc.Title Like "Certificate Error*" Then ieDoc.Links(1).Click While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend Set ieDoc = IE.Document End If If Len(edrpou) = 8 Then With ieDoc 'login If login = True Then Application.Wait (Now + TimeValue("0:00:01")) .getElementsByName("mylogin")(0).Value = log .getElementsByName("mypass")(0).Value = pass .getElementsByName("savepass")(0).Click '.getElementsByName("login")(0).Click '.getElementsByValue("submit")(0).Click .forms(0).submit While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend End If
.getElementsByName("group1")(0).Click .getElementsByName("edrpou")(0).Value = edrpou '.getElementsByName("im1")(0).Click .forms(0).submit While IE.Busy Or (IE.readyState <> 4): DoEvents: Wend 'WebPageText = .Body.innerText ' тянем text WebPageText = .Body.innerHTML ' тянем HTML End With Application.Wait (Now + TimeValue("0:00:05")) Результат = Get_table(IE) ' получаем таблицу
Else MsgBox ("КОД НЕ 8ми ЗНАЧНЫЙ") End If .Quit: Set IE = Nothing ' закрываем End With End Function Function Get_table(IE) Dim S As String For Each aTable In IE.Document.GetElementsByTagName("table") If aTable.className = "sample2" Then For n = 1 To aTable.Rows.Length - 1 ' первую строку,а это заголовок,пропускаем For m = 0 To aTable.Rows(n).Cells.Length - 1 S = S & aTable.Rows(n).Cells(m).innertext & ";" Next S = S & vbCrLf Next End If Next Get_table = S End Function
Спасибо большое за помощь! Если бы я знал все свойства, процедуры и функции компонента IE я бы так и сделал, но я не знаю, поэтому и собираю по кусочкам все копипастом + дописую то что знаю и понимаю.
Спасибо большое за помощь! Если бы я знал все свойства, процедуры и функции компонента IE я бы так и сделал, но я не знаю, поэтому и собираю по кусочкам все копипастом + дописую то что знаю и понимаю.Ivanius