URLDownloadToFile下载文件，文件保存但已损坏

Question

我正在尝试使用VBA来保存在线pdf。宏进入一个网站，登录，输入几个输入，然后生成一个PDF。 pdf将在新标签页中打开。我一直在使用URLDownloadToFile来保存pdf。我可以得到pdf来保存，但是，当我尝试打开它时，我收到此消息：Acrobat无法打开'pdfname.pdf'，因为它不是受支持的文件类型或因为文件已损坏（例如，它是作为电子邮件附件发送的，未被正确解码）。我无法共享链接，因为它是一个Intranet站点。

我认为问题是，因为pdf在新选项卡中打开，我登录的事实无法识别，这就是pdf被破坏的原因。有没有办法使用URLDownloadToFile输入用户名和密码？

我尝试过其他帖子的想法，比如使用https://username:[email protected]将凭据放在网址中，但这不起作用。我执行了网络跟踪以查找其他网址，但其他链接也无法正常工作。我也清除了缓存，当我检查网址的状态时，我得到“200 - OK”，但我仍然保存了一个损坏的文件。

任何帮助是极大的赞赏！

这是我的代码：

#If VBA7 Then
Private Declare PtrSafe Function DeleteUrlCacheEntry Lib "wininet" Alias _
    "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As LongPtr, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As LongPtr) As LongPtr
#Else
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias _
    "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long

Private 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

Public PageSource As String
Public httpRequest As Object

Function GetURLStatus(ByVal URL As String, Optional AllowRedirects As Boolean)
Const WinHttpRequestOption_UserAgentString = 0
Const WinHttpRequestOption_EnableRedirects = 6

On Error Resume Next
Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
If httpRequest Is Nothing Then
    Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5")
End If
Err.Clear
On Error GoTo 0

httpRequest.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
httpRequest.Option(WinHttpRequestOption_EnableRedirects) = AllowRedirects

'Clear any pervious web page source information
PageSource = ""

'Add protocol if missing
If InStr(1, URL, "://") = 0 Then
    URL = "http://" & URL
End If

'Launch the HTTP httpRequest synchronously
On Error Resume Next
httpRequest.Open "GET", URL, False
If Err.Number <> 0 Then
  'Handle connection errors
    GetURLStatus = Err.Description
    Err.Clear
    Exit Function
End If
On Error GoTo 0

'Send the http httpRequest for server status
On Error Resume Next
httpRequest.Send
httpRequest.WaitForResponse
If Err.Number <> 0 Then
  ' Handle server errors
    PageSource = "Error"
    GetURLStatus = Err.Description
    Err.Clear
Else
  'Show HTTP response info
    GetURLStatus = httpRequest.Status & " - " & httpRequest.StatusText
  'Save the web page text
    PageSource = httpRequest.responsetext
End If
On Error GoTo 0
End Function

sub macro()
'some code to generate pdf

    Dim strDest As String
    Dim strSource As String
    strSource = "https://url.pdf"
    strDest = "dir/folder/folder/pdfname.pdf"

    'CLEAR CACHE
    DeleteUrlCacheEntry (strSource)

    'CHECK URL
    Debug.Print GetURLStatus(strSource, True)

    'SAVE PDF
    URLDownloadToFile 0, strSource, strDest, 0, 0

End Sub

Answer 1

我找到了一个解决方法。如果你打开Adobe。您可以转到编辑 - >首选项 - > Internet。然后我取消选中“在浏览器中显示PDF”框。这样，PDF就在Adobe中生成，并且更容易使用。