Модераторы: mihanik
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Ссылка на катировки акций 
V
    Опции темы
Pogreb
Дата 31.1.2008, 01:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Awaiting Authorisation
Сообщений: 69
Регистрация: 17.10.2005

Репутация: нет
Всего: нет
Извините, может я пишу не в тот раздел.

Проблема такова. У меня есть Exсel файл, в котором написан макрос. Этот макрос считывал информацию с moneycentral.msn.com
но потом перестал работать. Не пойму в чем причина. 
Вот оригинальная ссылка http://moneycentral.msn.com/scripts/webquo...mp;Symbol=CIOBX 
CIOBX - это пример запрашиваемой инфы.

Может куда переехала эта DLL?
PM MAIL   Вверх
Naghual
Дата 31.1.2008, 11:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49
Ответить не видя сам макрос не представляется возможным.


--------------------
Я желаю всем Счастья!
PM ICQ Skype   Вверх
Pogreb
Дата 31.1.2008, 13:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Awaiting Authorisation
Сообщений: 69
Регистрация: 17.10.2005

Репутация: нет
Всего: нет
Код

Function GetQuote(strTicker As String)
    On Error Resume Next
    
    Const intMaxErrCount = 5
    
    Dim xmlHttpDoc
    Dim strSourceUrl As String, strInput As String
    Dim intStartPosn As Long, intEndPosn As Long
    Dim intErrorCount As Long
    Dim blnError As Boolean
    Dim strErrMsg As String
    Dim dblQuote As Double

    blnError = True
    intErrorCount = 0
    strTicker = UCase(Trim(strTicker))
    
    'http://moneycentral.msn.com/scripts/webquote.dll?iPage=qdext&Symbol=CIOBX
    

    strSourceUrl = "http://moneycentral.msn.com/scripts/webquote.dll?iPage=qdext&Symbol="      проблема в этой строке, но как ее решить я
    strSourceUrl = strSourceUrl & strTicker                                                                                         не знаю
    
    While intErrorCount <= intMaxErrCount And blnError
        Set xmlHttpDoc = CreateObject("MSXML2.XMLHTTP")
        blnError = False
        xmlHttpDoc.Open "GET", strSourceUrl, False
        xmlHttpDoc.Send
        strInput = xmlHttpDoc.responseText
        If Err.Number <> 0 Then
            strErrMsg = "Error connecting for " & strTicker & "."
            blnError = True
            intErrorCount = intErrorCount + 1
            wscript.sleep (intErrorCount * 1000)
            Err.Clear
        Else
            ' Parse Response
            If InStr(strInput, "Net Asset Value") Then
                ' It's a Fund
                ' Get the current quote
                dblQuote = 0
                intStartPosn = InStr(strInput, "Net Asset Value")
                intStartPosn = InStr(intStartPosn, strInput, "<B>&nbsp;") + 9
                intEndPosn = InStr(intStartPosn, strInput, "</B>")
                dblQuote = CDbl(Mid(strInput, intStartPosn, intEndPosn - intStartPosn))
                strErrMsg = ""
                If Err.Number <> 0 Then
                    strErrMsg = "Error parsing for " & strTicker & "."
                    blnError = True
                    intErrorCount = intMaxErrCount
                    Err.Clear
                End If
            ElseIf InStr(strInput, "<TD>Last</TD>") Then
                ' It's a Stock or Index
                ' Get the current quote
                dblQuote = 0
                intStartPosn = InStr(strInput, "Last")
                intStartPosn = InStr(intStartPosn, strInput, "<B>&nbsp;") + 9
                intEndPosn = InStr(intStartPosn, strInput, "</B>")
                dblQuote = CDbl(Mid(strInput, intStartPosn, intEndPosn - intStartPosn))
                strErrMsg = ""
                If Err.Number <> 0 Then
                    strErrMsg = "Error parsing for " & strTicker & "."
                    blnError = True
                    intErrorCount = intMaxErrCount
                    Err.Clear
                End If
            Else
                ' Major Error
                strErrMsg = "Fail"
            End If
        End If
        Set xmlHttpDoc = Nothing
    Wend

    If strErrMsg <> "" Then
        GetQuote = strErrMsg
    Else
        GetQuote = dblQuote
    End If

End Function




Ну вот сам код макроса
PM MAIL   Вверх
Naghual
Дата 31.1.2008, 15:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49
Проблема не в указанной вами строке, а, вероятнее всего, в том что изменился дизайн страницы с момента написания данного кода.


--------------------
Я желаю всем Счастья!
PM ICQ Skype   Вверх
Naghual
Дата 31.1.2008, 15:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49
Я проверил и убедился в своей правоте.
Вот вам участок кода, который нужно вставить в указанный вами макрос между строками 67 и 68 (в вашем посте):

Код

            ElseIf InStr(strInput, "<tr class=""rs0""><th colspan=""4""><span class=""s1"">") Then
                dblQuote = 0
                intStartPosn = InStr(strInput, "<tr class=""rs0""><th colspan=""4""><span class=""s1"">") + 49
                intEndPosn = InStr(intStartPosn, strInput, "</span>")
                dblQuote = CDbl(Replace(Mid(strInput, intStartPosn, intEndPosn - intStartPosn), ".", ","))
                strErrMsg = ""
                If Err.Number <> 0 Then
                    strErrMsg = "Error parsing for " & strTicker & "."
                    blnError = True
                    intErrorCount = intMaxErrCount
                    Err.Clear
                End If


И будет вам счастье.


--------------------
Я желаю всем Счастья!
PM ICQ Skype   Вверх
Pogreb
Дата 31.1.2008, 22:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Awaiting Authorisation
Сообщений: 69
Регистрация: 17.10.2005

Репутация: нет
Всего: нет
Может еще поможете, мне надо получать то число которое на рисунке выделено.
Просто я не щарю в интернет технологиях, и на VB никогда не писал.
Спасибо большое.

Присоединённый файл ( Кол-во скачиваний: 10 )
Присоединённый файл  123.jpg 82,28 Kb
PM MAIL   Вверх
Naghual
Дата 31.1.2008, 22:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1893
Регистрация: 15.5.2004
Где: Украина, Днепр

Репутация: 7
Всего: 49
Именно это число и получается моим кодом


--------------------
Я желаю всем Счастья!
PM ICQ Skype   Вверх
Pogreb
Дата 31.1.2008, 22:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Awaiting Authorisation
Сообщений: 69
Регистрация: 17.10.2005

Репутация: нет
Всего: нет
А у меня нет. Вот сам файл.

Это сообщение отредактировал(а) Pogreb - 2.2.2008, 20:10
PM MAIL   Вверх
Pogreb
Дата 31.1.2008, 23:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Awaiting Authorisation
Сообщений: 69
Регистрация: 17.10.2005

Репутация: нет
Всего: нет
Спасибо, решил свою проблему. Деление со школы я еще не забыл  smile 
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Программирование, связанное с MS Office"
mihanik staruha

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами


  • Несанкционированная реклама на форуме запрещена
  • Пожалуйста, давайте своим темам осмысленный, информативный заголовок. Вопль "Помогите!" таковым не является.
  • Чем полнее и яснее Вы изложите проблему, тем быстрее мы её решим.
  • Оставляйте свои записи в "Книге отзывов о работе администрации"
  • А вот тут лежит FAQ нашего подраздела

Если Вам понравилась атмосфера форума, заходите к нам чаще!
С уважением mihanik и staruha.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Программирование, связанное с MS Office | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0961 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.