Правильность URL

[Klim Bassenger]

Всем привет!!!
Имеем код по которому переходим на страничку в интернете для скачивания файлика:
With CreateObject("InternetExplorer.Appl ication")
.Navigate "http://titan-pro.org/titan-pro.org_2.04.09.rar"
.MenuBar = False
.Toolbar = False
.Resizable = False
.StatusBar = False
.AddressBar = False
' .FullScreen = True
.Visible = False
End With
Нужно, сделать так, чтобы если такая ссылка актуальна( то есть по ней можно скачать прайс), то писала что-то типа "Самая свежая версия прайса уже скачана!"
Ну а если на сайт "выкинут" более свежий файлик (соответственно у него название буде другое, например, "http://titan-pro.org/titan-pro.org_2.09.09.rar"), то нужно, чтобы предлагало скачать данный файл!!!

Ну или как-то организовать так называемое скачивание обновления с данного сайта!!!
Заранее всем спасибо!!!

[EducatedFool]

Ну а если на сайт "выкинут" более свежий файлик (соответственно у него название буде другое, например, "http://titan-pro.org/titan-pro.org_2.09.09.rar"), то нужно, чтобы предлагало скачать данный файл!!!

А как Вы намерены получать имя самого свежего файла?
Ориентируясь по текущей дате? Перебирая все даты, начиная с сегодняшней, и проверяя, скачается ли файл по сформированной ссылке?


Скачать файл несложно. Пример есть здесь

Ваш код будет выглядеть примерно так:

Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Function DownLoadFile(FromPathName As String, ToPathName As String) As Boolean
    DownLoadFile = URLDownloadToFile(0, FromPathName, ToPathName, 0, 0) = 0
End Function

Sub Main()
    Dim ссылка As String, Filename As String
    Link = "http://titan-pro.org/titan-pro.org_ДАТА.rar"
    Filename = Replace(Environ(24), "TEMP=", "") & "\price"
    ' скачанный прайс найдёте здесь: C:\WINDOWS\TEMP\price
    On Error Resume Next: Kill Filename

    For d = Now To Now - 30 Step -1    ' за последние 30 дней
        ссылка = Replace(Link, "ДАТА", Format(d, "d.mm.yy"))
        Debug.Print "Ищем файл: ", ссылка
        If DownLoadFile(ссылка, Filename) Then
            MsgBox "Скачан прайс за " & Format(d, "DD MMMM YYYY")
            Exit Sub
        End If
        Debug.Print "Проверена дата: ", d
    Next
End Sub

В окне Immediate Вы увидите что-то вроде этого:

Ищем файл: http://titan-pro.org/titan-pro.org_2.09.09.rar
Проверена дата: 02.09.2009 21:56:39
Ищем файл: http://titan-pro.org/titan-pro.org_1.09.09.rar
Проверена дата: 01.09.2009 21:56:39
Ищем файл: http://titan-pro.org/titan-pro.org_31.08.09.rar
Проверена дата: 31.08.2009 21:56:39

[Aent]

Вариант

Option Explicit
Public Sub GetPriceUpdate()
    Dim oXMLHTTP As Object
    Dim sHTMLBody As String
    Dim sURL As String
    Dim sPriceName As String
    Dim sPricePath As String
    Dim sFullPriceName As String
    Dim i As Long, j As Long
    
    Dim oADOStream As Object

    sURL = "http://titan-pro.org/"
    sPricePath = "C:\PRICE\"
    Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.4.0")
    '             или CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", sURL, False
        '    раскомментируйте следующие строки и подставьте верные IP, логин и пароль если вы сидите за proxy
        '    .setProxy 2, "192.168.100.1:3128"
        '    .setProxyCredentials "user", "password"
        .send
        sHTMLBody = .responseText
    End With
    sPriceName = vbNullString
    i = InStr(sHTMLBody, ".rar")
    If i > 0 Then
        j = InStrRev(sHTMLBody, "/", i)
        If j > 0 Then
            sPriceName = Mid$(sHTMLBody, j + 1, i - j + 3)
        End If
    End If
    if len(sPriceName) = 0 then exit sub
    sFullPriceName = sPricePath & sPriceName
    If Len(Dir(Replace(sFullPriceName, ".rar", ".xls"))) = 0 Then  ' Нет такого файла
        With oXMLHTTP
            .Open "GET", sURL & "/" & sPriceName, False
            .send
        End With
        Set oADOStream = CreateObject("ADODB.Stream")
        With oADOStream
            .Mode = 3    'разрешение на чтение и запись
            .Type = 1  'тип данных - Binary
            .Open
            .Write oXMLHTTP.responseBody
            .SaveToFile sFullPriceName, 1 'сохранение (2 вместо 1 означает разрешение на перезапись файла)
        End With
        ' Распаковываем архив
        Shell "UnRAR.exe x -inul -u " & sFullPriceName & " " & sPricePath, vbHide
        Application.Wait (Now + TimeValue("0:00:05")) 'Ждём 5 секунд для распаковки архива
        If Len(Dir(Replace(sFullPriceName, ".rar", ".xls"))) > 0 Then
           ' убираем архивный файл
           Kill sFullPriceName
        End If
        MsgBox "Прайс обновлён"
    Else
        MsgBox "Прайс " & sPriceName & " уже закачан"
    End If
End Sub

При желании можно(нужно) добавить обработку ошибок и удаление старых прайсов. Предполагается что путь к UNRAR есть в системном окружении

[Klim Bassenger]

Сообщение от EducatedFool

А как Вы намерены получать имя самого свежего файла?

Нет даты перебирать я не собирался...
Я хотел URL адрес ввести в какую-нибудь ячейку и при открытии проверять правильность ссылки... Если ссылка в ячейке и URL эдентичны, то ничего не делаем,ну а если не совпадают, то закачиваем файл, после чего соответственно вносим новый URL в ячейку и т.д.

Дело в том, что код который привел я просто открывает эту страницу, пишет, что страница не найдена и всё.... При чем EXCEL естественно это за ошибку не считает и поэтому ничего отследить не получается...

[Klim Bassenger]

[/QUOTE]
Что-то не работает... То файл не найден, то еще какая-нибудь ошибка!

[EducatedFool]

Что-то не работает... То файл не найден, то еще какая-нибудь ошибка!

Конечно, файл не будет найден.
Мы-то что можем поделать, если на сервере нет файлов с такими именами...

[Klim Bassenger]

Мы-то что можем поделать, если на сервере нет файлов с такими именами...[/QUOTE]
Ваш код как раз работает!

[Aent]

Klim Bassenger, пройдите по шагам (по F8) и скажите где падает.
У меня полностью работает. Т.е скачивает .rar при отсутствии в каталоге прайса одноимённого .xls, распаковывает его и удаляет .rar