0

我正在尝试使用 VBA 在 HTTPS 站点上提交文件，但我遇到了身份验证问题。（查看时，该站点具有文件名的标准字段，带有“浏览”按钮和“提交”按钮。）

我已经尝试了几件事……首先，我使用了一个InternetExplorer.Application对象，但我需要填充的元素类型是file，并且我读到出于安全原因，它不能通过代码直接访问。（对不起，我没有引用链接...）

下一个建议是使用一个WinHttp.WinHttpRequest.5.1对象和一个PUT请求。但是，当我这样做时，来自站点的响应是 401，无效的身份验证错误。

当我正常浏览时，我无需输入任何凭据即可访问该站点。我在此处和此处查看了有关 HTTPS 标头的一些问题，但无法使它们正常工作。谁能看到我做错了什么？

Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://siteImUploadingTo.domain.com/site"
objHTTP.Open "PUT", URL, False

objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
objHTTP.Send ("_fileToPost=" & ThisWorkbook.Path & \filename.PDF&_pagesSelection=1-100")
Debug.Print objHTTP.ResponseText 'returns a 401 invalid credentials error.
4

1 回答 1

1

查看您的代码，您似乎错过了一个.SetCredentials电话， after.Open和 before .Send：

objHTTP.SetCredentials username, password, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER

我在我的测试环境中运行了您的代码，并且我还必须设置WinHttpRequestOption_SslErrorIgnoreFlags能够忽略所有 SSL 错误的选项（参考）：

objHTTP.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300 //SslErrorFlag_Ignore_All

最后，我认为您的Send命令无法实际将文件发布到您的服务器。我建议您使用以下代码，改编自这篇博文。

' add a reference to "Microsoft WinHTTP Services, version 5.1"
Public Function PostFile( _
    sUrl As String, sFileName As String, sUsername As String, sPassword As String, _
    Optional bIgnoreAllSslErrors As Boolean = False, Optional bAsync As Boolean _
) As String
    Const HTTPREQUEST_SETCREDENTIALS_FOR_SERVER = 0
    Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
    Dim nFile           As Integer
    Dim baBuffer()      As Byte
    Dim sPostData       As String
    Dim browser         As WinHttp.WinHttpRequest

    '--- read file
    nFile = FreeFile
    Open sFileName For Binary Access Read As nFile
    If LOF(nFile) > 0 Then
        ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
        Get nFile, , baBuffer
        sPostData = StrConv(baBuffer, vbUnicode)
    End If
    Close nFile

    '--- prepare body
    sPostData = _
        "--" & STR_BOUNDARY & vbCrLf & _
            "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
            "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
            sPostData & vbCrLf & _
        "--" & STR_BOUNDARY & "--"

    '--- post
    Set browser = New WinHttpRequest
    browser.Open "POST", sUrl, bAsync

    browser.SetCredentials sUsername, sPassword, HTTPREQUEST_SETCREDENTIALS_FOR_SERVER

    If bIgnoreAllSslErrors Then
        ' https://stackoverflow.com/questions/12080824/how-to-ignore-invalid-certificates-with-iwinhttprequest#12081003
        browser.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300
    End If

    browser.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
    browser.Send pvToByteArray(sPostData)
    If Not bAsync Then
        PostFile = browser.ResponseText
    End If
End Function

Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function

如果您需要发送其他字段，可以通过修改 sPostData 变量来实现：

sPostData = _
    "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""field1""" & vbCrLf & vbCrLf & _
        field1 & vbCrLf & _
    "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""field2""" & vbCrLf & vbCrLf & _
        field2 & vbCrLf & _
    "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(FileFullPath, InStrRev(FileFullPath, "\") + 1) & """" & vbCrLf & _
        "Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
        sPostData & vbCrLf & _
    "--" & STR_BOUNDARY & "--"
于 2015-10-05T06:15:32.833 回答