Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.60/10: Рейтинг темы: голосов - 10, средняя оценка - 4.60
Temper_sgy
8 / 3 / 0
Регистрация: 18.06.2013
Сообщений: 17
1

Проверка URL адреса на существование

21.08.2013, 15:59. Просмотров 1821. Ответов 10
Метки нет (Все метки)

Доброго времени суток!
Есть определенный цикл по перебору страниц сайта, цикл определяет некоторые недоступные страницы вследствие их отсутствия.

возможно ли определить отсутствующие страницы?
0
Лучшие ответы (1)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
21.08.2013, 15:59
Ответы с готовыми решениями:

Проверка листа на существование
Ребята подскажите как узнать существует лист или нет??? Делаю так: Sub...

Циклическая проверка на существование папки и ее создание
Ситуация звучит таким образом: необходима небольшая программа которая в...

Проверка адреса в ячейке
Добрый день уважаемые форумчане! Подскажите пожалуйста мне как решить следующую...

Проверка адреса по шаблону в пользовательской функции
есть вот такой код для проверки введенного e-mail по шаблону, но если имеил...

Проверка на существование proxy адреса
Добрый день У меня такой вопрос Каким кодом я могу осуществить проверку на...

10
The_Prist
1302 / 283 / 63
Регистрация: 13.11.2008
Сообщений: 589
21.08.2013, 20:00 2
Можно так попробовать:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub Test()
    Debug.Print Test_URL("yandex.ru")
End Sub
Function Test_URL(sURL_Addr As String)
    Dim objMatches As Object, objFSO As Object, objTmpFile As Object
    Dim txtAll As String, sTmpTxtFile As String, sTmpRes As String
 
    sTmpTxtFile = Environ("TEMP") & "\url_temp.txt"
 
    CreateObject("WScript.Shell").Run "%comspec% /c ping " & sURL_Addr & " > " & sTmpTxtFile, 0, True
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTmpFile = objFSO.GetFile(sTmpTxtFile)
    With objTmpFile.OpenAsTextStream(1)
        txtAll = .ReadAll: .Close
    End With
    Kill sTmpTxtFile
 
    With CreateObject("VBScript.Regexp")
        .Pattern = "(\d{1,3}\.){3}\d{1,3}": .Global = False
        Set objMatches = .Execute(txtAll)
    End With
    If objMatches.Count Then
        sTmpRes = "Адрес существует"
    Else
        sTmpRes = "Адрес не существует"
    End If
    Test_URL = sTmpRes
End Function
0
Catstail
Модератор
23868 / 11918 / 2102
Регистрация: 12.02.2012
Сообщений: 19,371
21.08.2013, 20:12 3
ping-у нужен ip/имя_хоста, а не URL.
0
Dmitrii
2603 / 535 / 107
Регистрация: 21.03.2012
Сообщений: 1,043
21.08.2013, 21:43 4
Цитата Сообщение от Catstail Посмотреть сообщение
ping-у нужен ip/имя_хоста, а не URL
Годится и URL.
1
Миниатюры
Проверка URL адреса на существование  
Catstail
Модератор
23868 / 11918 / 2102
Регистрация: 12.02.2012
Сообщений: 19,371
21.08.2013, 22:03 5
Но "www.cyberforum.ru" - это не URL, а имя хоста.... URL - это еще и адрес страницы (как и написано у TC). Пропинговать можно хост сайта, но определить пингом отдельные страницы вряд ли удастся.
0
Dmitrii
2603 / 535 / 107
Регистрация: 21.03.2012
Сообщений: 1,043
21.08.2013, 22:17 6
Цитата Сообщение от Catstail Посмотреть сообщение
... URL - это еще и адрес страницы...
Ну, при таком уточнении "пингование", конечно, не подходит.
0
Temper_sgy
8 / 3 / 0
Регистрация: 18.06.2013
Сообщений: 17
22.08.2013, 10:41  [ТС] 7
страницы имеют следующую структуру
http://cbr.ru/credit/f135.asp?regn=3279&when=20101201
3279 - рег номер банка
20101201 - дата
если взять дату в будущем
http://cbr.ru/credit/f135.asp?regn=3279&when=20141201
сайт откроется с отсутствующими данными, но vba в принципе его не видит и пишет следующее сообщение:
Проверка URL адреса на существование

При нажатие на ОК цикл прекращается со следующей ошибкой:
Проверка URL адреса на существование


само начало цикла выглядит так:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Adr = Array("http://cbr.ru/credit/101.asp?regnum=", "&when=0&dt=", _
            "http://cbr.ru/credit/102.asp?regnum=", "&when=0&dt=", _
            "http://cbr.ru/credit/f134.asp?regn=", "&when=", _
            "http://cbr.ru/credit/f135.asp?regn=", "&when=")
 
While Cells(2 + i, 1) <> ""
    i = i + 1
       
    For j = 1 To 4
    
        www = Adr(j * 2 - 2) & Cells(1 + i, 1) & Adr(j * 2 - 1) & Cells(1 + i, 2)
        F_name = Cells(1 + i, 3) & "-" & Cells(1 + i, 1) & "-" & Cells(1 + i, 2) & "-" & Mid(Adr(j * 2 - 2), 22, 3) & j + 1
        
        
        Workbooks.Open (www)
где столбец 1 содержит рег. номера, столбец 2 - дату, столбец 3 - название банка.

может быть можно сделать условие на проверку всех форм банка (кроме 102, квартальная форма), и, при существовании форм, выполнять дальнейшие операции?
0
Temper_sgy
8 / 3 / 0
Регистрация: 18.06.2013
Сообщений: 17
23.08.2013, 14:19  [ТС] 8
может быть кому поможет. не используя ip и ping

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub ImportFromCBR()
 
    www = "http://cbr.ru/credit/f135.asp?regn=3279&when=20151201" 'сайт для проверки
 
    Dim oXMLHTTP As Object
            Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
            With oXMLHTTP
                
            .Open "GET", www, False
            End With
            
            oXMLHTTP.Send
                If oXMLHTTP.Status = 200 Then
                    MsgBox "файл\страница существует"
                Else
                    MsgBox oXMLHTTP.Status & " " & "файл\страница не существует"
                End If
End Sub
1
DimN
97 / 48 / 0
Регистрация: 14.08.2013
Сообщений: 230
Записей в блоге: 4
23.08.2013, 14:30 9
У меня вот такое пишет на адрес http://kk7c.ru

Проверка URL адреса на существование
0
The_Prist
1302 / 283 / 63
Регистрация: 13.11.2008
Сообщений: 589
23.08.2013, 15:49 10
Лучший ответ Сообщение было отмечено как решение

Решение

Надо чуть изменить:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub CheckURL()
    Dim strFullFileName As String
    strFullFileName = "http://www.cyberforum.ru/vba/thread941319.html"
    If CheckState(strFullFileName) = False Then
        MsgBox "Сайт недоступен:" & vbCr & strFullFileName
    Else
        MsgBox "Сайт доступен:" & vbCr & strFullFileName
    End If
End Sub
 
Function CheckState(strAdr As String) As Boolean
    On Error Resume Next
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", strAdr, False
        .Send
        If Err.Number = 0 Then
            If .Status = 200 Then CheckState = True
        End If
    End With
End Function
3
dev.Free
Заблокирован
24.08.2013, 07:12 11
ADODB.Field error '80020009'

Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record.

/credit/f135.asp, line 0
Забавно у них там ADODB используется ))))
0
24.08.2013, 07:12
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
24.08.2013, 07:12

Проверка введенного url адреса на корректность
Здравствуйте, требуется ваша помощь не могли бы подсказать как организовать...

[C++] Взятие адреса конструктора. Физическое время существование объекта.
1. конструктор. class A { int a; public: A():a(555){}; ~A(){}

Проверка на существование
есть таблица Client со столбцами (Name,LastName,MobilePhoneNumber,Email) и...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru