Тема: VBS: Вытащить данные из динамичной таблицы
.
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Серый форум → Общение → Windows Script Host, HTA (VBScript, JScript) → VBS: Вытащить данные из динамичной таблицы
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
.
charony, начните отсюда: Супер-тема, заходите — не пожалеете.
.
.
.
это фаил из которого пытаюсь вытащить
Откуда такой кошмар взялся? Он же невалиден совсем.
getElementsByClassName
IE9+?
.
Угу. Так что с:
Откуда такой кошмар взялся?
Надо бы как-то постараться получить более валидный html.
Угу. Так что с:
Откуда такой кошмар взялся?
Надо бы как-то постараться получить более валидный html.
кинул на мыло
charony, без преобразований данных — примерно так (IE6):
Option Explicit
Const READYSTATE_COMPLETE = 4
Dim strUrl
Dim objHTMLTableRow
Dim objHTMLTableCell
Dim SomeValue
Dim strContent
Dim strPath
strUrl = "http://www.cmegroup.com/trading/fx/g10/euro-fx_quotes_settlements_options.html"
With WScript.CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate strUrl
Do
WScript.Sleep 100
Loop Until Not .Busy And .ReadyState = READYSTATE_COMPLETE
strContent = ""
With .Document.GetElementByID("settlementsOptionsProductTable")
.deleteTHead
.deleteTFoot
For Each objHTMLTableRow In .rows
If objHTMLTableRow.rowIndex < .rows.length - 1 Then
For Each objHTMLTableCell In objHTMLTableRow.cells
SomeValue = objHTMLTableCell.innerText
'Select Case objHTMLTableCell.cellIndex
' Case 1
' SomeValue = CSng(SomeValue) / 1000
' Case 2
' Select Case SomeValue
' Case "Call"
' SomeValue = 0
' Case "Put"
' SomeValue = 1
' End Select
' Case 3, 4, 5, 6
' If SomeValue = "-" Then
' SomeValue = 0
' End If
' Case 7, 8
' SomeValue = CSng(SomeValue)
' Case 9
' SomeValue = CSng(SomeValue) * 1000
' Case Else
' ' Nothing to do
'End Select
strContent = strContent & SomeValue
If objHTMLTableCell.cellIndex < objHTMLTableRow.cells.length - 1 Then
strContent = strContent & ";"
End If
Next
strContent = strContent & vbCrLf
End If
Next
End With
.Quit
End With
With WScript.CreateObject("Scripting.FileSystemObject")
strPath = .BuildPath(WScript.CreateObject("WScript.Shell").SpecialFolders("Desktop"), "data.txt")
With .CreateTextFile(strPath, True, True)
.Write strContent
.Close
End With
End With
WScript.CreateObject("WScript.Shell").Run """" & strPath & """", 1, False
WScript.Quit 0
А вот по поводу преобразований данных — давайте подробнее. Например, Вы пишете… Так. Зачем Вы зачистили текст своих сообщений? Не делайте так больше.
1 = если 1095 то 1.095
Что это значит? Содержимое столбца «Strike» должно быть разделено на 1000?
2 = если С то 0, Если Р то 1
А в столбце «Type» нет ни «С», ни «Р». Есть «Call», либо «Put».
7 = если -.00140 то -0.00140
8 = если .12350 то 0.12350
Добавить лидирующий «0» в число? Будет ли допустимо, если результатом в столбцах «Change» и «Settle» будет не «-0.00140», а «-0.0014», т.е. без незначащих нулей в конце?
Далее, как быть, если значением в столбце «Change» оказывается «UNCH», а в столбце «Settle» — значение «CAB»? Нужен ли в результате знак «+», который также может присутствовать в столбце «Change» — например, «+.00030»?!
9 = если 2,567 то 2567
Умножить значение столбца «Estimated Volume» на 1000?
А в столбце «Type» нет ни «С», ни «Р».
Для цитирования пользуйтесь тэгом «quote».
Попробуйте так:
Option Explicit
Const READYSTATE_COMPLETE = 4
Dim strUrl
Dim objHTMLTableRow
Dim objHTMLTableCell
Dim SomeValue
Dim strContent
Dim lngPrevLocale
Dim strPath
strUrl = "http://www.cmegroup.com/trading/fx/g10/euro-fx_quotes_settlements_options.html"
With WScript.CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate strUrl
Do
WScript.Sleep 100
Loop Until Not .Busy And .ReadyState = READYSTATE_COMPLETE
strContent = ""
lngPrevLocale = SetLocale("en-us")
With .Document.GetElementByID("settlementsOptionsProductTable")
.deleteTHead
.deleteTFoot
For Each objHTMLTableRow In .rows
If objHTMLTableRow.rowIndex < .rows.length - 1 Then
For Each objHTMLTableCell In objHTMLTableRow.cells
SomeValue = objHTMLTableCell.innerText
Select Case objHTMLTableCell.cellIndex
Case 0
If IsNumeric(SomeValue) Then
SomeValue = CSng(SomeValue) / 1000
End If
Case 1
Select Case SomeValue
Case "Call"
SomeValue = 0
Case "Put"
SomeValue = 1
End Select
Case 2, 3, 4, 5
If SomeValue = "-" Then
SomeValue = 0
End If
Case 6, 7
If IsNumeric(SomeValue) Then
SomeValue = CSng(SomeValue)
ElseIf SomeValue = "UNCH" Or SomeValue = "CAB" Then
SomeValue = -1
End If
Case 8, 9
If IsNumeric(SomeValue) Then
SomeValue = CLng(SomeValue)
End If
End Select
strContent = strContent & SomeValue
If objHTMLTableCell.cellIndex < objHTMLTableRow.cells.length - 1 Then
strContent = strContent & ";"
End If
Next
strContent = strContent & vbCrLf
End If
Next
End With
SetLocale lngPrevLocale
.Quit
End With
With WScript.CreateObject("Scripting.FileSystemObject")
strPath = .BuildPath(WScript.CreateObject("WScript.Shell").SpecialFolders("Desktop"), "data.txt")
With .CreateTextFile(strPath, True, True)
.Write strContent
.Close
End With
End With
WScript.CreateObject("WScript.Shell").Run """" & strPath & """", 1, False
WScript.Quit 0
На всякий случай добавил временное принятие разделителей как в США: у меня работает и так, но я всегда сам меняю у себя разделители — десятичная точка у меня именно точка, а не запятая, и разделитель разрядов у меня запятая, а не пробел. Потому добавил на всякий случай. Пробуйте.
первую строку , не нужно
IE не закрывается процесс после работы скрипта
первую строку не нужно , вот так должно быть как в файле
и если .12250В то 0.12250 если .12030А то 0.1203 т.е без букв
IE не закрывается процесс после работы скрипта
Как я понимаю, такое бывает. И не только при программном закрытии: After closing IE windows iexplore.exe processes are still running - Microsoft Community. У меня на IE6 такого не наблюдается. Сожалею.
первую строку , не нужно
первая строка должна начинаться с цифры
и если .12250В то 0.12250 если .12030А то 0.123
Пробуйте:
Option Explicit
Const READYSTATE_COMPLETE = 4
Dim strUrl
Dim objHTMLTableRow
Dim objHTMLTableCell
Dim SomeValue
Dim strContent
Dim lngPrevLocale
Dim strPath
strUrl = "http://www.cmegroup.com/trading/fx/g10/euro-fx_quotes_settlements_options.html"
With WScript.CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate strUrl
Do
WScript.Sleep 100
Loop Until Not .Busy And .ReadyState = READYSTATE_COMPLETE
strContent = ""
lngPrevLocale = SetLocale("en-us")
With .Document.GetElementByID("settlementsOptionsProductTable")
.deleteTHead
.deleteTFoot
For Each objHTMLTableRow In .rows
If objHTMLTableRow.rowIndex > 0 And objHTMLTableRow.rowIndex < .rows.length - 1 Then
For Each objHTMLTableCell In objHTMLTableRow.cells
SomeValue = objHTMLTableCell.innerText
Select Case objHTMLTableCell.cellIndex
Case 0
If IsNumeric(SomeValue) Then
SomeValue = CSng(SomeValue) / 1000
End If
Case 1
Select Case SomeValue
Case "Call"
SomeValue = 0
Case "Put"
SomeValue = 1
End Select
Case 2, 3, 4, 5
If SomeValue = "-" Then
SomeValue = 0
ElseIf Right(SomeValue, 1) = "A" Or Right(SomeValue, 1) = "B" Then
SomeValue = Left(SomeValue, Len(SomeValue) - 1)
If IsNumeric(SomeValue) Then
SomeValue = CSng(SomeValue)
End If
End If
Case 6, 7
If IsNumeric(SomeValue) Then
SomeValue = CSng(SomeValue)
ElseIf SomeValue = "UNCH" Or SomeValue = "CAB" Then
SomeValue = -1
End If
Case 8, 9
If IsNumeric(SomeValue) Then
SomeValue = CLng(SomeValue)
End If
End Select
strContent = strContent & SomeValue
If objHTMLTableCell.cellIndex < objHTMLTableRow.cells.length - 1 Then
strContent = strContent & ";"
End If
Next
strContent = strContent & vbCrLf
End If
Next
End With
SetLocale lngPrevLocale
.Quit
End With
With WScript.CreateObject("Scripting.FileSystemObject")
strPath = .BuildPath(WScript.CreateObject("WScript.Shell").SpecialFolders("Desktop"), "data.txt")
With .CreateTextFile(strPath, True, True)
.Write strContent
.Close
End With
End With
WScript.CreateObject("WScript.Shell").Run """" & strPath & """", 1, False
WScript.Quit 0
Если нормально — закомментируйте видимость окна IE:
.Visible = Trueи уберите открытие результирующего файла в связанном приложении:
WScript.CreateObject("WScript.Shell").Run """" & strPath & """", 1, FalseКстати, обратите внимание — в Вашем коде данные дописывались в текстовый файл, я же его переписываю заново целиком. Смените вобрат, если Вам надо иначе.
и киньте РР адрес
Вот сюда: Поддержка данного ресурса, если есть желание, можете попробовать перечислить на поддержку ресурса.
У меня на IE6 такого не наблюдается. Сожалею.
А зачем сожалеть? Добавьте перед .Quit выход из программы .ExecWB 45, 2 и всё.
Flasher, сожалею, потому как не могу в этом помочь. Я даже теоретически не могу проверить на IE11, поскольку не на что его ставить. Вот тут Вам и карты в руки
.
Вообще-то с IE8 та же петрушка. А помочь можете указанной добавкой. ![]()
много спасибо , все работает как нужно
alexii пишет:У меня на IE6 такого не наблюдается. Сожалею.
А зачем сожалеть? Добавьте перед .Quit выход из программы .ExecWB 45, 2 и всё.
.ExecWB 45, 2 .Quit
так?
@ alexii
может у знакомых есть PayPal?
так?
Через :
.ExecWB 45, 2 : .Quitмного всем спасибо
и с наступающим
так?
Через :
Или в две строки:
…
SetLocale lngPrevLocale
.ExecWB 45, 2
.Quit
End With
…
charony, так сработал «.ExecWB» или нет?
Flasher, а нужен ли тогда «.Quit»?
может у знакомых есть PayPal?
У меня нет таких знакомых
. Я спрошу завтра у atomix'а — может, у него есть.
да все прекрасно работает, остальное я запилю как мне нужно
спасибо еще раз
буду рад поддержать через РР
я еще спросить хотел
есть ли возможность получить тот же результат , через стандартные виндуфф dll?
Flasher, а нужен ли тогда «.Quit»?
Да. Quit - это не завершение программы, а закрытие объекта.
да все прекрасно работает, остальное я запилю как мне нужно
Ну, вот и славненько.
Да. Quit - это не завершение программы, а закрытие объекта.
Но вот у меня — завершает.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться