excel - 登录页面后如何使用 URLDownloadToFile 下载(用户名和密码)
问题描述
我在网上找到了这段代码。pdf 下载为非常小的 6 KB 文件。我假设它是从登录页面下载 html 信息,而不是链接发送到的 PDF。无论如何在代码中包含登录凭据,以便宏将下载实际的 PDF?如果您需要,我还将在下面包含涉及用户名和密码的 chrome 源代码。
此外,这个使用的代码只是选择保存 PDF 的位置,但我没有包含代码。它还使用工作簿中的一列来获取 URL,并使用另一列将文件命名为“xxxxx.pdf”
谢谢!
来自chrome的登录页面源代码:
<table border="0" cellpadding="0" cellspacing="0" width="100%">
<tbody>
<tr>
<td>
<table align="center" bgcolor="#6d768d" border="0" cellpadding="0" cellspacing="1" width="600" class="logintable">
<tbody>
<tr>
<td bgcolor="#ffffff" height="250" width="250">
<form name="loginForm" method="post" action="j_security_check" AUTOCOMPLETE="OFF">
<table border="0" cellpadding="5" cellspacing="0" width="245">
<tbody>
<tr>
<td width="69">
<font color="#666666" face="Verdana, Arial, Helvetica, sans-serif" size="2">User Name:</font>
</td>
<td width="156">
<label>
<input name="j_username" type="text" autocorrect="off" autocapitalize="off">
</label>
</td>
</tr>
<tr>
<td>
<font color="#666666" face="Verdana, Arial, Helvetica, sans-serif" size="2">Password:</font>
</td>
<td>
<label>
<input name="j_password" type="password">
</label>
</td>
</tr>
<tr>
<td>
</td>
我正在使用的代码:
Option Explicit
'API function declaration for both 32 and 64bit Excel.
#If VBA7 Then
Private Declare PtrSafe 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
#Else
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
Sub DownloadFiles()
'--------------------------------------------------------------------------------------------------
'The macro loops through all the URLs (column C) and downloads the files at the specified folder.
'The given file names (column D) are used to create the full path of the files.
'If the file is downloaded successfully an OK will appear in column E (otherwise an ERROR value).
'The code is based on API function URLDownloadToFile, which actually does all the work.
'--------------------------------------------------------------------------------------------------
'Declaring the necessary variables.
Dim sh As Worksheet
Dim DownloadFolder As String
Dim LastRow As Long
Dim SpecialChar() As String
Dim SpecialCharFound As Double
Dim FilePath As String
Dim i As Long
Dim j As Integer
Dim Result As Long
Dim CountErrors As Long
'Disable screen flickering.
Application.ScreenUpdating = False
'Set the worksheet object to the desired sheet.
Set sh = Sheets("Main")
'An array with special characters that cannot be used for naming a file.
SpecialChar() = Split("\ / : * ? " & Chr$(34) & " < > |", " ")
'Find the last row.
With sh
.Activate
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
End With
'Check if the download folder exists.
DownloadFolder = sh.Range("B4")
On Error Resume Next
If Dir(DownloadFolder, vbDirectory) = vbNullString Then
MsgBox "The folder's path is incorrect!", vbCritical, "Folder's Path Error"
sh.Range("B4").Select
Exit Sub
End If
On Error GoTo 0
'Check if there is at least one URL.
If LastRow < 8 Then
MsgBox "You did't enter a single URL!", vbCritical, "No URL Error"
sh.Range("C8").Select
Exit Sub
End If
'Clear the results column.
sh.Range("E8:E" & LastRow).ClearContents
'Add the backslash if doesn't exist.
If Right(DownloadFolder, 1) <> "\" Then
DownloadFolder = DownloadFolder & "\"
End If
'Counting the number of files that will not be downloaded.
CountErrors = 0
'Save the internet files at the specified folder of your hard disk.
On Error Resume Next
For i = 8 To LastRow
'Use the given file name.
If Not sh.Cells(i, 4) = vbNullString Then
'Get the given file name.
FilePath = sh.Cells(i, 4)
'Check if the file path contains a special/illegal character.
For j = LBound(SpecialChar) To UBound(SpecialChar)
SpecialCharFound = InStr(1, FilePath, SpecialChar(j), vbTextCompare)
'If an illegal character is found substitute it with a "-" character.
If SpecialCharFound > 0 Then
FilePath = WorksheetFunction.Substitute(FilePath, SpecialChar(j), "-")
End If
Next j
'Create the final file path.
FilePath = DownloadFolder & FilePath
'Check if the file path exceeds the maximum allowable characters.
If Len(FilePath) > 255 Then
sh.Cells(i, 5) = "ERROR"
CountErrors = CountErrors + 1
End If
Else
'Empty file name.
sh.Cells(i, 5) = "ERROR"
CountErrors = CountErrors + 1
End If
'If the file path is valid, save the file into the selected folder.
If UCase(sh.Cells(i, 5)) <> "ERROR" Then
'Try to download and save the file.
Result = URLDownloadToFile(0, sh.Cells(i, 3), FilePath, 0, 0)
'Check if the file downloaded successfully and exists.
If Result = 0 And Not Dir(FilePath, vbDirectory) = vbNullString Then
'Success!
sh.Cells(i, 5) = "OK"
Else
'Error!
sh.Cells(i, 5) = "ERROR"
CountErrors = CountErrors + 1
End If
End If
Next i
On Error GoTo 0
'Enable the screen.
Application.ScreenUpdating = True
'Inform the user that macro finished successfully or with errors.
If CountErrors = 0 Then
'Success!
If LastRow - 7 = 1 Then
MsgBox "The file was successfully downloaded!", vbInformation, "Done"
Else
MsgBox LastRow - 7 & " files were successfully downloaded!", vbInformation, "Done"
End If
Else
'Error!
If CountErrors = 1 Then
MsgBox "There was an error with one of the files!", vbCritical, "Error"
Else
MsgBox "There was an error with " & CountErrors & " files!", vbCritical, "Error"
End If
End If
End Sub
解决方案
推荐阅读
- java - Heroku 在 90 秒工作 Java 电报机器人后崩溃
- c++ - 使用 taglib 读取元数据时
- vuetify.js - Vuetify-DataTable 改变表头高度
- html - Angular 4 - 如何在 ngFor 循环中为标签设置唯一的 id 值?
- ng-zorro-antd - NzPaginationComponent got TypeError: templateRef.createEmbeddedView is not a function
- selenium - Firefox 不适用于硒网格
- scala - 在将期货与参与者消息混合时确保测试中的消息顺序
- jquery - 从文本文件的 Section 中生成 JSON 数据
- php - Laravel - 无法迁移具有 1:N 和 1:1 关系的表
- javascript - 如何解码搜索字符串 %..%.. php