为什么我的VBA代码没有从文件夹中下载所有文件

Question

我正在使用一段代码从Sharepoint中提取文件，然后将它们下载到桌面上的本地文件夹。然而，我注意到，当有大量文件要下载时，它只下载部分文件，即使所有文件都有成功导出确认消息。请帮忙！

Sub download_file()
Dim dlpath, documenttosrc, filename As String
Dim i As Double

i = 11
Do
dlpath = Worksheets(CN.Name).Cells(i, 5).Value
documenttosrc = Worksheets(CN.Name).Cells(i, 2).Value
filename = Worksheets(CN.Name).Cells(i, 3).Value & ".pdf"

URLDownloadToFile 0, documenttosrc, dlpath & filename, 0, 0

Worksheets(CN.Name).Cells(i, 6).Value = " Download completed"
i = i + 1  
Loop Until Cells(i, 1).Value = ""

MsgBox ("Download done")
End Sub

Answer 1

请注意，URLDownloadToFile函数有一些返回值是无效的。

• S_OK
  下载成功启动

• E_OUTOFMEMORY
  缓冲区长度无效，或者内存不足，无法完成操作

• INET_E_DOWNLOAD_FAILURE
  指定的资源或回调接口无效

因此，即使下载失败，您也会一直在单元格中写入" Download completed"，因为您没有检查它是否失败。

因此，您需要获得函数的返回值并对其进行验证

声明函数可以返回的以下常量。

Const S_OK As Long = 0
Const E_OUTOFMEMORY As Long = &H8007000E
Const INET_E_DOWNLOAD_FAILURE As Long = &H800C0002

并验证如下：

Dim RetVal As Long
RetVal = URLDownloadToFile(0&, documenttosrc, dlpath & filename, 0&, 0&)
Select Case RetVal
Case S_OK: 
CN.Cells(i, 6).Value = " Download completed"
Case E_OUTOFMEMORY: 
CN.Cells(i, 6).Value = " The buffer length is invalid, or there is insufficient memory to complete the operation."
Case INET_E_DOWNLOAD_FAILURE: 
CN.Cells(i, 6).Value = " The specified resource or callback interface was invalid."
Case Else:
CN.Cells(i, 6).Value = " Unknown Error: " & RetVal
End Select 

所以你的代码应该是这样的：

Option Explicit
#If VBA7 And Win64 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) 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
Private Const S_OK As Long = 0
Private Const E_OUTOFMEMORY As Long = &H8007000E
Private Const INET_E_DOWNLOAD_FAILURE As Long = &H800C0002
Public Sub DownloadFiles()
Dim ws As Worksheet
Set ws = CN 'note that CN is already a worksheet so `Worksheets(CN.Name)` is not necessary you can directly use CN
Dim i As Long
i = 11
Do
Dim dlpath As String
dlpath = ws.Cells(i, 5).Value
Dim documenttosrc As String
documenttosrc = ws.Cells(i, 2).Value
Dim filename As String
filename = ws.Cells(i, 3).Value & ".pdf"

Dim RetVal As Long
RetVal = URLDownloadToFile(0&, documenttosrc, dlpath & filename, 0&, 0&)

Select Case RetVal
Case S_OK: 
ws.Cells(i, 6).Value = " Download completed"
Case E_OUTOFMEMORY: 
ws.Cells(i, 6).Value = " The buffer length is invalid, or there is insufficient memory to complete the operation."
Case INET_E_DOWNLOAD_FAILURE: 
ws.Cells(i, 6).Value = " The specified resource or callback interface was invalid."
Case Else:
ws.Cells(i, 6).Value = " Unknown Error: " & RetVal
End Select 
i = i + 1  
Loop Until ws.Cells(i, 1).Value = vbNullString Or i = ws.Rows.Count

MsgBox "Download done"
End Sub