I am needing to download all the PDFs from a webpage and save them into a folder. The PDFs on the webpage are downloaded via different links. Here is the webpage that the PDFs are located: NRCS Engineering Manuals and Handbooks | NRCS North Dakota. I have already created the folder location as shown below:
Function FileFolderExists(strFullPath As String) As Boolean
'Macro Purpose: Check if a folder exists
On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True
EarlyExit:
On Error GoTo 0
End Function
'Creates file folder for saving imported precipitation data
'Used as Micro for "Make Destination Folder" Button
Sub Make_Folder()
Dim objFSO As Object
Dim objFolder As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object associated with the directory
Set objFolder = objFSO.GetFolder(CurDir())
Range("u11").Select
Selection.ClearContents
' Opens windows explorer for creation of folder to save .pdf files
If Len(Dir(CurDir() & "\Stockwater PDFs", vbDirectory)) = 0 Then MkDir(CurDir() & "\Stockwater PDFs")
If FileFolderExists(CurDir() & "\Stockwater PDFs") Then
MsgBox "Folder Created Sucessfully!!!"
Else
MsgBox "Folder does not exist!"
End If
If FileFolderExists(CurDir() & "\Stockwater PDFs") Then
ActiveSheet.Range("u11").Value = "Stockwater PDFs folder made in the " & objFolder.Name
End If
End Sub
Once the files are downloaded from the website (the first part of the code below that I need help with) I would then list what files are located within the folder they were saved into (which I have already):
Sub GetWebPageDocs()
' Erases all listed files shown to be located in the CurDir()\Stockwater PDFs folder
Range("n17:n50").Select
Selection.ClearContents
Range("n16").Select
' Lists current files located in the CurDir()\Stockwater PDFs folder
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object associated with the directory
Set objFolder = objFSO.GetFolder(CurDir() & "\Stockwater PDFs")
irow = 17
icolumn = 14
ActiveSheet.Range("N16").Value = "The files found in the " & objFolder.Name & " folder are:"
'Loop through the Files collection
For Each objFile In objFolder.Files
ActiveSheet.Cells(irow, icolumn).Value = objFile.Name
irow = irow + 1
icolumn = icolumn
Next
'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub
If it would be easier to have all the desired PDFs located within a ZIP file that was a single link on the website then that may be the best option.
Thanks in advance for the help.
I have tried the following but get a compile error on Dim xHTTP As MSXML2.XMLHTTP
Dim sUrl As String
Dim xHttp As MSXML2.XMLHTTP
Dim hDoc As MSHTML.HTMLDocument
Dim hAnchor As MSHTML.HTMLAnchorElement
Dim Ret As Long
Dim sPath As String
Dim i As Long
sPath = CurDir() & "\Stockwater PDFs"
sUrl = "http://www.nrcs.usda.gov/wps/portal/nrcs/detail/nd/technical/engineering/?cid=stelprdb1269591"
'Get the directory listing
Set xHttp = New MSXML2.XMLHTTP
xHttp.Open "GET", sUrl
xHttp.send
'Wait for the page to load
Do Until xHttp.readyState = 4
DoEvents
Loop
'Put the page in an HTML document
Set hDoc = New MSHTML.HTMLDocument
hDoc.body.innerHTML = xHttp.responseText
'Loop through the hyperlinks on the directory listing
For i = 0 To hDoc.getElementsByTagName("a").Length - 1
Set hAnchor = hDoc.getElementsByTagName("a").Item(i)
'test the pathname to see if it matches your pattern
If hAnchor.pathname Like "*.pdf" Then
Ret = URLDownloadToFile(0, sUrl & hAnchor.pathname, sPath & hAnchor.pathname, 0, 0)
If Ret = 0 Then
Debug.Print sUrl & hAnchor.pathname & " downloaded to " & sPath
Else
Debug.Print sUrl & hAnchor.pathname & " not downloaded"
End If
End If
Next i