SOS~自动登陆网站下载Excel文件求助

Stone_00x

以下两个问题,各位路过的大神有碰到过的请帮忙解惑,谢谢!
1>自动输入账号密码登陆问题:
我在公司的电脑运行到CreateObject("InternetExplorer.Application")这里会报错,在网上查到的是要将IE浏览器设为默认浏览器,
公司电脑跟家里电脑都是Win10系统,公司电脑将IE改成默认浏览器后需要重启才可以顺利运行,但是过一会又在又在CreateObject("InternetExplorer.Application")报错,要重新设置IE为默认浏览器并重启才行,但是家里的电脑就没问题,
家里的电脑装了IE跟360,不用设置IE为默认浏览器,直接用360浏览器就可以用VBA自动登陆了

2>下载文件问题:
公司是内部网站,下载的文件打开内容会报错,我在家用http://ehtest.ys168.com/这个网站测试下载又没问题....

Sub DownloadTest()
    Dim sUrl As String, sPassword As String
    sUrl = "http://ehtest.ys168.com/"
    '1自动登陆网站
    With CreateObject("InternetExplorer.Application")
        .navigate sUrl
        .Visible = True
        Do While .readystate <> 4
            DoEvents
        Loop
        With .Document
            .getElementById("bdglymm").Value = "ehtest"
            .getElementById("sutjgl").Click
        End With
    End With

    '2下载文件
    Dim DownloadUrl As String
    Const strFileName As String = "D:\Desktop\B.xlsx"
    DownloadUrl = "http://ys-j.ys168.com/614105927/S7hjsgm443823864TOU8/TestB.xlsx"
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", DownloadUrl, False
        .send
        ByteToFile .responseBody, strFileName
    End With

End Sub

Sub ByteToFile(arrByte, strFileName As String)
    With CreateObject("Adodb.Stream")
        .Type = 1 'adTypeBinary
        .Open
        .Write arrByte
        .SaveToFile strFileName, 2 'adSaveCreateOverWrite
        .Close
    End With
End Sub

changhong8

Mark一下。。。。。。