Macro Download from site/Макрос для скачивания с сайта

[IgorGO]

сайт секретный...
имя файла неизвестно...

кто тут чем поможет???

[sanych_09]

сайт не секретный: http://ut-tracker.com/tracker/login
просто информация в файле для неразглашения, может быть она и не секретная, но не хотелось бы чтобы у меня из-за этого были проблемы
имя файла
PH1_New_Colocation_DPR_NEW_20150818 _1700H, но меняется только дата и время когда генерируется файл в системе, для этого файла есть гиперссылка = http:// ut-tracker.com/tracker/projectone/report/downloadable/download/325

аналогично для других отчетов. есть ссылки, и имена файлов - кроме даты и времени генерирования отчетов

[sanych_09]

Доброго времени суток
хочу продолжить тему по скачиванию файлов, но с использованием гиперссылок


подскажите, как изменить макрос, чтобы файлы закачивались по умолчанию в нужную папку и не выскакивали окна (в моем случае) Chome c предложением куда сохранить файл
спасибо!

Sub DownloadFiles()
' Downloads files given by any hyperlinks in Column A.
    Const strPath As String = "d:\Test\"
    Dim strFile As String, lnum As Long
    Dim rng As Range
    
    Set rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For lnum = 1 To rng.Count
        strFile = Range("A" & lnum).Value
        
    ThisWorkbook.FollowHyperlink strFile
        With ActiveWorkbook
            .SaveAs strPath & strFile
            
            .Close
        End With
    Next lnum
     
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

[EducatedFool]

а поиском пробовали пользоваться?
http://excelvba.ru/code/DownloadFile

или другой вариант:

#If VBA7 Then        '  Office 2010-2013
    Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
            (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, _
             ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr
#Else        '  Office 2003-2007
    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
#End If

Function DownLoadFileFromURL(ByVal URL$, ByVal LocalPath$) As Boolean
    On Error Resume Next
    DownLoadFileFromURL = URLDownloadToFile(0, URL$, LocalPath$, 0, 0) = 0
End Function


Sub test()
    СсылкаНаФайл$ = "http://excelvba.ru/sites/default/files/3.jpg"
    ПутьДляСохранения$ = "C:\test.jpg"

    ' скачиваем файл из интернета
    If DownLoadFileFromURL(СсылкаНаФайл$, ПутьДляСохранения$) Then
        MsgBox "файл скачан"
    Else
        MsgBox "что-то пошло не так..."
    End If
End Sub

[sanych_09]

к сожалению не скачивается предложенным Вами кодом, а тот код который в Вы предложили по ссылке - создает просто пустой файл

может подскажете, как получить имя файла (в предыдущем посте я писал)

когда использовал код

MsgBox WinHttpReq.GetAllResponseHeaders

было видно имя файла, сейчас не видно.

[EducatedFool]

просто не перечитал тему с начала, - не обратил внимания, что скачивать файлы нужно с авторизацией

загрузка файла с авторизацией выполняется примерно так:

' выполняем GET запрос для получения файла
                With HTTP
                    .Open "GET", DownloadURL$, False

                    .SetRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
                    .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
                    ' добавляем прочие заголовки запроса
                    .SetRequestHeader "Cookie", СюдаПишемCookieКоторыеОтвечаютЗаАвторизацию

                    .Send: DoEvents

                    ' сохраняем ответ сервера в файл
                    If .Status = 200 Then
                        res = True
                        Set oStream = CreateObject("ADODB.Stream")
                        oStream.Open
                        oStream.Type = 1
                        oStream.Write .ResponseBody
                        oStream.SaveToFile filename$, 2        ' 1 = no overwrite, 2 = overwrite
                        oStream.Close
                        'Debug.Print "Downloading with auth done: Len = " & Len(.ResponseText)
                    Else
                        'Debug.Print "error downloading file with auth: Status = " & .Status
                    End If
                End With

аналогичный вариант можно найти у меня на сайте
http://excelvba.ru/code/DownloadFileWithAuth

PS: сразу скажу, - если у вас не заработает, гадать что там не так и исправлять код не буду
Я просто показал примеры, как это делается при помощи макросов