Question

Image of data in excel我正在使用超链接从网上下载一些数据，并将下载的数据放入使用A列中列出的名称创建的文件夹中。

当一个文件夹只有一个超链接时，现在数据已成功下载，但现在我还想将2个以上的文件数据放入同一个文件夹中。

有人可以建议一种增强代码的方法吗？

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澄清之后

已编辑他没有超链接

根据您显示的代码和链接，您的代码实际上并不创建新文件夹，而是在“C：\ Users \ a3rgcw \ Downloads \”文件夹中创建了许多新文件（即您的FolderName变量< / p>

并且由于这些文件名是使用ws.Range("A" & i).Value & ".zip"构建的，因此对于任何列A单元格中的每个相同值，它都会使用新文件覆盖现有文件

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

为了避免文件覆盖，您可以使用“文件夹”名称（来自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

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

1 个答案: