VBA Macro in Excel to save html files from cells r

2019-08-24 04:51发布

I want to save a web page in a html file using a VBA Macro in Excel. However, I'm totally new doing VBA Macros. For downloading and save I found this code and it works.

Option Explicit
Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
  ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
  ByVal lpfnCB As Long) As Long


Public Sub Example1()
    DownloadFile "http://www.betbrain.pl/", "c:\p.html"
End Sub


Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
    'Thanks Mentalis:)
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFileA(0, URL, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function

But what I would like to do in addition, is to make the URL address and the name to save the html file two arguments to choose. What I expect from the code is to select a range of cells containing the URLs and others containing the path and names to save the file. I found the following example, and I have tried to combine both codes, but definitively I haven't had success in many tries.

Sub Proper_Case()
    'Updateby20150428
    Dim x As Range
    Dim Workx As Range

    On Error Resume Next

    xTitleId = "KutoolsforExcel"
    Set Workx = Application.Selection
    Set Workx = Application.InputBox("Range", xTitleId, Workx.Address, Type:=8)

    For Each x In Workx
        x.Value = Application.Proper(x.Value)
    Next
End Sub

Could you please give some help.
Thanks in advance, Jaime.

1条回答
看我几分像从前
2楼-- · 2019-08-24 05:02

I think this could work. I'm assuming that your URL and Destination File ranges are the same size, and the first URL and Destination go together. In other words, the first URL saves to the first Destination in the list, second URL saves to second destination, etc.

Sub getURLS()
Dim x       As Range, urlRange As Range, saveToRange As Range
Dim i As Long

i = 1

Set urlRange = Application.InputBox("Range of URLs", "URLS", Type:=8)
Set saveToRange = Application.InputBox("Range of destinations", "Destinations", Type:=8)

For Each x In urlRange
    DownloadFile x.Value, saveToRange.Cells(i, 1).Value
    i = i + 1
Next

End Sub
查看更多
登录 后发表回答