我必須在不使用Internet Explorer的情況下使用vba登錄

Question

我必須登錄page。但是，我無法使用它。

由於保密性，我無法提供username和password。

這裏是我的代碼：

Sub checkdownload() 


    Dim ur As String 
    Dim pth As String 
    ur = "http://industryoutlook.cmie.com/kommon/bin/sr.php?kall=wrddmp&type=dmp&tabcode=&frequency=A&colno=1&repnum=6254&dnbtn=1" 

    Dim targetFolder As String, targetFileZip As String, targetFileCSV As String, targetFileTXT As String 
    enter code here 
    Dim wkbAll As Workbook 
    Dim wkbTemp As Workbook 
    Dim sDelimiter As String 
    Dim newSheet As Worksheet 
    Dim finalWorkSheetName As String 

    pth = "E:\fitch intern\project 3" 
    Debug.Print pth 
    targetFolder = pth & "\temp" 
    'msgbox url & targetFolder 
    If Len(Dir(targetFolder, vbDirectory)) <> 0 Then 
     On Error Resume Next 
     Kill targetFolder & "\*.*" 
     RmDir targetFolder 
     MkDir targetFolder 
    Else 
     MkDir targetFolder 
    End If 
    targetFileZip = targetFolder & "\data.zip" 
    targetFileCSV = targetFolder & "\data.csv" 
    targetFileTXT = targetFolder & "\data.txt" 

    DownloadZipFile targetFileZip, ur 

End Sub 

Sub DownloadZipFile(zipFileName As String, url As String) 


Dim fso As Object 
    Dim xmlObj As Object, stream As Object 
    Dim strSource As String 
    Dim cookie As String 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Dim loginPageUrl As String, loginFormUrl As String, dataFormURL As String 
    Dim loginFormData As String, dataFormData As String, responseData As Variant 



    loginPageUrl = "https://industryoutlook.cmie.com/index.php" 
    loginFormUrl = "https://industryoutlook.cmie.com/kommon/bin/sr.php?kall=wlogin" 
    dataFormURL = url 

    loginFormData = "username=........&password=...........&submit=Login" 
    dataFormData = "" 

    'Make a request to get the session cookie 
    Call MakeSessionRequest("GET", loginPageUrl, loginFormData, cookie, True) 
    'Make a request to submit the login form 
    Call MakeSessionRequest("POST", loginFormUrl, loginFormData, cookie) 
    'Make a request to submit the data form 
    Call MakeSessionRequest("POST", dataFormURL, dataFormData, cookie) 
    'Get the zip file contents from the server 
    responseData = MakeSessionRequest("GET", dataFormURL, dataFormData, cookie) 
    Debug.Print zipFileName 

    'Write the returned zip file contents to a file on disk 
    Set stream = CreateObject("ADODB.stream") 
    Const adTypeBinary = 1 
    Const adSaveCreateNotExist = 1 
    Const adSaveCreateOverWrite = 2 
    stream.Type = adTypeBinary 
    stream.Open 

    stream.write responseData 

    stream.SaveToFile zipFileName, adSaveCreateOverWrite 

    stream.Close 

    Set stream = Nothing 
    Set xmlObj = Nothing 



End Sub 

Function MakeSessionRequest(method As String, url As String, data As String, _ 
ByRef cookie As String, Optional ByRef updateCookie = False) As Byte() 

    If Len(cookie) = 0 Then cookie = "dummy=dummy;" 
    httpReferrer = Trim(url) 
    postVars = Trim(data) 

Dim XMLHTTP As Object 

    Set XMLHTTP = CreateObject("MSXML2.serverXMLHttp") 
    XMLHTTP.Open method, Trim(url), False 

    If UCase(method) = "POST" Then 
     XMLHTTP.SetRequestHeader "Content-Type", _ 
         "application/x-www-form-urlencoded" 
    End If 
    XMLHTTP.SetRequestHeader "Referer", httpReferrer 'in case the server cares 
    XMLHTTP.SetRequestHeader "Cookie", "to deal with XMLHTTP bug" 
    XMLHTTP.SetRequestHeader "Cookie", cookie 
    XMLHTTP.Send postVars 

    'wait for response 
    While XMLHTTP.readyState <> 4 
     XMLHTTP.waitForResponse 1000 
    Wend 

    ' extract the cookie data from the response header 
    If updateCookie Then 
     cookie = "" 
     strheaders = XMLHTTP.getAllResponseHeaders() 
     harr = Split(strheaders, "Set-Cookie: ") 
     For kk = 1 To UBound(harr) 
      theCookie = Left(harr(kk), InStr(harr(kk), "path=/") - 2) 
      cookie = cookie & " " & theCookie 
     Next 
    End If 

    'return the response body 
    MakeSessionRequest = XMLHTTP.responseBody 
    Set XMLHTTP = Nothing 
End Function 

Answer 1

試試這個小腳本。

Sub DownloadData() 

Dim lColumn As Long 
Dim iCntr As Long 
Dim ws As Worksheet 
Dim rwsToCheck As Long 
Dim MyRange As Range 
Dim iCounter As Long 
Dim LastRow As Long 
Dim LastColumn As Long 

Set ie = CreateObject("InternetExplorer.application") 

' Get username and password from worksheet. Not very secure, but this way the credentials are always sitting in the same spot and the user doesn't have to enter these each time. 
' Alternative is to use an input box toprompt the user for crednetials. 
UserName = Worksheets("ControlSheet").Range("A1").Value 
Password = Worksheets("ControlSheet").Range("A2").Value 

With ie 
    .Visible = True 
    .navigate "https://YOUR_URL_HERE" 

' Wait for the page to fully load; you can't do anything if the page is not fully loaded 
Do While .Busy Or _ 
    .readyState <> 4 
    DoEvents 
Loop 

On Error Resume Next 
'Credentials are passed to the site and the button is clicked (by the code). 
ie.document.forms(0).all("username").Value = UserName 
ie.document.forms(0).all("password").Value = Password 
ie.document.forms(0).submit.Click 

    ' Wait for the page to fully load; you can't do anything if the page is not fully loaded 
    Do While .Busy Or _ 
     .readyState <> 4 
     DoEvents 
    Loop 

    .navigate "ANOTHER_URL_AFTER_YOU_LOGIN" 

    Do While .Busy Or _ 
     .readyState <> 4 
     DoEvents 
    Loop 

Set myDoc = ie.document 

' MORE LOGIC HERE... 

End Sub