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

时间:2017-12-18 16:53:06

标签: vba excel-vba pdf excel

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

我认为问题是,因为pdf在新标签页中打开,我登录的事实无法识别,这就是pdf损坏的原因。有没有办法使用URLDownloadToFile输入用户名和密码?

我已尝试过其他帖子中的提示,例如使用https://username:password@link.pdf将凭据放入网址但不起作用。我执行了网络跟踪以查找其他网址,但其他链接也没有工作。我也清除了缓存,当我检查网址的状态时,我得到了" 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

1 个答案:

答案 0 :(得分:0)

我找到了解决方法。如果你打开Adobe。您可以转到Edit-&gt; Preferences-&gt; Internet。然后我取消选中“在浏览器中显示PDF”框。这样,PDF就是在Adobe中生成的,并且更容易使用。