Как использовать URLDownloadToFile для загрузки после страницы входа (имя пользователя и пароль) - PullRequest
1 голос
/ 22 апреля 2020

Я нашел этот код онлайн. Файлы PDF загружаются в виде очень маленьких файлов размером 6 килобайт. Я предполагаю, что он загружает информацию 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>
                                         &nbsp;
                                      </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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...