Скачать файл с ограничением доступа к логину с использованием объекта IE - PullRequest
Новая
       48

Скачать файл с ограничением доступа к логину с использованием объекта IE

0 голосов
/ 28 мая 2020

может показаться, что этот вопрос задают много раз, однако я не смог найти тот, который соответствует моим требованиям.

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

В настоящее время я использую элемент управления веб-браузером в сочетании с функцией DownloadURLtoFile или winHTTReq для загрузки файлов. Пользователи запускают пользовательскую форму с помощью веб-браузера, вводят свои учетные данные, затем я проверяю, был ли вход в систему успешным, и скрываю пользовательскую форму. Затем, просматривая нужный URL-файл, я отбрасываю другую полезную информацию и, наконец, плавно загружаю отчет. Оба метода загрузки файлов используют уже существующий сеанс веб-управления, и больше ничего не нужно.

К сожалению, поведение объекта IE отличается, когда я запускаю любой из обоих методов после пользователь успешно вошел в систему, и я скрываю экран, загруженный файл имеет http-код, запрашивающий идентификатор пользователя и пароль.

Кто-нибудь знает, можно ли привязать любой из этих двух методов загрузки файлов для использования IE объектный сеанс?

Извините за длинное объяснение, надеюсь, я понял мой запрос.

PS: Если вы спросите, почему я перехожу на IE, если управление через веб-браузер работает, потому что мне нужно убрать разные страницы с контейнерами сценариев java, и это намного проще с IE.

Hello @ Deepak-MSFT, чтобы ответить на ваш вопрос, ответ - нет, файл я попал, когда сеанс не логируется, приходит с правой страницы. Здесь вы go макросы, которые работают правильно: 

Sub Login()  

    URL = "myapplication.com"
    UserForm1.WebBrowser1.navigate URL '<- This request is redirected to the global login page.

    'Wait until page is fully loaded
    Do While UserForm1.WebBrowser1.ReadyState = 4: DoEvents: Loop
    Do Until UserForm1.WebBrowser1.ReadyState = 4: DoEvents: Loop
    While UserForm1.WebBrowser1.Busy
        DoEvents
    Wend

    UserForm1.show

End Sub

Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
'This Macro is located in the UserForm1. Will leave Webbrowser opened until the user
'loggin succesffuly. After that I hide the userform and continue with the download.

    'Check if appls is logged and hide the browser
    LoginStatement = "Welcome to the Intranet" '<= String which appears when appls is logged

    Document = WebBrowser1.Document.DocumentElement.innerText

    pos1 = InStr(Document, LoginStatement)

    If pos1 Then
        Me.hide
    End If

End Sub

Sub Download()
    'Main procedure

    Dim myURL As String: myURL = "myapplication.com"
    Call Login
    sFile_Name = "test.csv"
    sPath = "c:\temp"
    sFile_Path = sPath & "\" & sFile_Name

    Dim winHttpReq As Object
    Set winHttpReq = CreateObject("Microsoft.XMLHTTP")
    winHttpReq.Open "GET", myURL, False
    winHttpReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"

    On Error GoTo URL_Unreachable
    winHttpReq.Send

    On Error GoTo Wrong_Directory
    If winHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write winHttpReq.ResponseBody
        oStream.SaveToFile sFile_Path, 2 ' 1 = no overwrite, 2 = overwrite
        oStream.Close
    Else
        MsgBox "Something went wrong... file couldn't be downloaded"
    End If
    Set winHttpReq = Nothing
    Exit Sub

URL_Unreachable:
    MsgBox "URL unreachable. Please check your connection and try again"
    Application.StatusBar = False
    Set winHttpReq = Nothing
    End

Wrong_Directory:
    Application.StatusBar = "Reporting path directory inaccessible"
    MsgBox "The Reporting path: " & sPath & " is not accesible or you don't have enough permisions." & _
            vbCrLf & vbCrLf & "Please update it and try again"
    Application.StatusBar = False
    Set winHttpReq = Nothing
    End
End Sub

Затем, если я заменю предыдущий макрос входа в систему следующим, файл не будет загружен, так как Excel не видит установленного открытого сеанса. 

Sub login()

    Dim HTMLDoc As MSHTML.HTMLDocument
    Dim URL, LoginStatement As String: URL = "myapplication.com"
    Dim pos1 As Integer: pos1 = 0

    LoginStatement = "Welcome to the Intranet" '<= String which appears when appls is logged

    Set IE = New InternetExplorerMedium
    With IE
        .Navigate URL: .visible = True
        Do While .ReadyState <> READYSTATE_COMPLETE Or .Busy
        Loop
        On Error Resume Next
        Set HTMLDoc = .Document.DocumentElement.innerText
        If (pos1 = InStr(Document, LoginStatement)) Then
            .visible = False
            Exit Sub
        End If
     Wend
End Sub
...