从超链接下载数据到使用vba创build新文件夹

Excel中数据的图像我正在使用超链接从网上下载一些数据，并将下载的数据放入使用A列中列出的名称创build的文件夹中。

现在当一个文件夹只有一个超链接时，数据成功下载，但是现在我也想把两个以上的文件数据放到同一个文件夹中。

任何人都可以提出一种方法来增强代码，以允许？

Option Explicit 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 Dim ret As Long '> This is where the files will be saved. Change as applicable Const FolderName As String = "C:\Users\a3rgcw\Downloads\" Sub Download() Dim ws As Worksheet Dim lastRow As Long, i As Long Dim strPath As String Set ws = Sheets("Sheet1") lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row For i = 1 To lastRow strPath = FolderName & ws.Range("A" & i).Value & ".zip" ret = URLDownloadToFile(0, ws.Range("D" & i).Value, strPath, 0, 0) If ret = 0 Then ws.Range("F" & i).Value = "PR data successfully downloaded" Else ws.Range("F" & i).Value = "Unable to download PR data" End If Next i End Sub 

Answer 1

在OP说明之后编辑他没有超链接

根据你所显示的代码和链接，你的代码实际上并不创build新的文件夹，而是在“C：\ Users \ a3rgcw \ Downloads”文件夹中创build了许多新文件（即你的FolderNamevariables

因为这些文件名是用ws.Range("A" & i).Value & ".zip"构build的，那么对于任何列中的每个相同的值，一个单元格会覆盖现有的文件

此外，当您的代码从列“D”（ ws.Range("D" & i).Value读取它们时，链接将显示带有超链接的列“C”

为了避免覆盖文件，可以使用“文件夹”名称（来自列A单元格）和文件名称（来自相应的超链接地址）的组合来定义zip名称，如下所示（假定您的超链接列的代码假设是有效的）

 Sub Download() Dim ws As Worksheet Dim LastRow As Long, i As Long Dim strPath As String Set ws = Sheets("Sheet1") LastRow = ws.Range("A" & Rows.Count).End(xlUp).row For i = 1 To LastRow strPath = FolderName & _ ws.Range("A" & i).Value & "-" & _ GetName(ws.Range("D" & i)) & ".zip" ret = URLDownloadToFile(0, ws.Range("D" & i).Value, strPath, 0, 0) If ret = 0 Then ws.Range("F" & i).Value = "PR data successfully downloaded" Else ws.Range("F" & i).Value = "Unable to download PR data" End If Next i End Sub Function GetName(rng As Range) As String With rng GetName = Right(.Value, Len(.Value) - InStrRev(.Value, "/")) End With End Function 

这也可以重构如下：

 Sub Download() Dim strPath As String Dim cell As Range With Sheets("Sheet1") For Each cell In .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) strPath = FolderName & _ cell.Value & "-" & _ GetName(cell.Offset(, 3)) & ".zip" ret = URLDownloadToFile(0, cell.Offset(, 3).Value, strPath, 0, 0) cell.Offset(, 5).Value = IIf(ret = 0, "PR data successfully downloaded", "Unable to download PR data") Next End With End Sub Function GetName(rng As Range) As String With rng GetName = Right(.Value, Len(.Value) - InStrRev(.Value, "/")) End With End Function