Executing URL from within ms access [duplicate] - ms-access

I need to download a CSV file from a website using VBA in Excel. The server also needed to authenticate me since it was data from a survey service.
I found a lot of examples using Internet Explorer controlled with VBA for this. However, it was mostly slow solutions and most were also convoluted.
Update:
After a while I found a nifty solution using Microsoft.XMLHTTP object in Excel. I thought to share the solution below for future reference.

This solution is based from this website:
http://social.msdn.microsoft.com/Forums/en-US/bd0ee306-7bb5-4ce4-8341-edd9475f84ad/excel-2007-use-vba-to-download-save-csv-from-url
It is slightly modified to overwrite existing file and to pass along login credentials.
Sub DownloadFile()
Dim myURL As String
myURL = "https://YourWebSite.com/?your_query_parameters"
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "username", "password"
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile "C:\file.csv", 2 ' 1 = no overwrite, 2 = overwrite
oStream.Close
End If
End Sub

Declare PtrSafe 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
Sub Example()
DownloadFile$ = "someFile.ext" 'here the name with extension
URL$ = "http://some.web.address/" & DownloadFile 'Here is the web address
LocalFilename$ = "C:\Some\Path" & DownloadFile !OR! CurrentProject.Path & "\" & DownloadFile 'here the drive and download directory
MsgBox "Download Status : " & URLDownloadToFile(0, URL, LocalFilename, 0, 0) = 0
End Sub
Source
I found the above when looking for downloading from FTP with username and address in URL. Users supply information and then make the calls.
This was helpful because our organization has Kaspersky AV which blocks active FTP.exe, but not web connections. We were unable to develop in house with ftp.exe and this was our solution. Hope this helps other looking for info!

A modified version of above to make it more dynamic.
Public Function DownloadFileB(ByVal URL As String, ByVal DownloadPath As String, ByRef Username As String, ByRef Password, Optional Overwrite As Boolean = True) As Boolean
On Error GoTo Failed
Dim WinHttpReq As Object: Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", URL, False, Username, Password
WinHttpReq.send
If WinHttpReq.Status = 200 Then
Dim oStream As Object: Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
oStream.SaveToFile DownloadPath, Abs(CInt(Overwrite)) + 1
oStream.Close
DownloadFileB = Len(Dir(DownloadPath)) > 0
Exit Function
End If
Failed:
DownloadFileB = False
End Function

I was struggling for hours on this until I figured out it can be done in one line of powershell:
invoke-webrequest -Uri "http://myserver/Reports/Pages/ReportViewer.aspx?%2fClients%2ftest&rs:Format=PDF&rs:ClearSession=true&CaseCode=12345678" -OutFile "C:\Temp\test.pdf" -UseDefaultCredentials
I looked into doing it purely in VBA but it runs to several pages, so I just call my powershell script from VBA every time I want to download a file.
Simple.

Public Sub Test_DownloadFile()
Dim URLStr As String, DLPath As String, UName As String, PWD As String, DontOverWrite As Boolean
URLStr = "http.."
DLPath = Environ("USERPROFILE") & "\Downloads\TEST.PDF"
UName = ""
PWD = ""
DontOverWrite = False
Call DownloadFile(URLStr, DLPath, UName, PWD, DontOverWrite)
End Sub
Public Sub DownloadFile(ByVal URLStr As String, ByVal DLPath As String, Optional ByVal UName As String, Optional ByVal PWD As String, Optional DontOverWrite As Boolean)
On Error GoTo Failed
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", URLStr, False, UName, PWD
WinHttpReq.send
If WinHttpReq.status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
Dim OWrite As Integer
If DontOverWrite = True Then
OWrite = 1
Else
OWrite = 2
End If
oStream.SaveToFile DLPath, OWrite
oStream.Close
Debug.Print "Downloaded " & URLStr & " To " & DLPath
Exit Sub
End If
Failed:
Debug.Print "Failed to DL " & URLStr
End Sub

A modified version of above solution to make it more dynamic.
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
Public Function DownloadFileA(ByVal URL As String, ByVal DownloadPath As String) As Boolean
On Error GoTo Failed
DownloadFileA = False
'As directory must exist, this is a check
If CreateObject("Scripting.FileSystemObject").FolderExists(CreateObject("Scripting.FileSystemObject").GetParentFolderName(DownloadPath)) = False Then Exit Function
Dim returnValue As Long
returnValue = URLDownloadToFile(0, URL, DownloadPath, 0, 0)
'If return value is 0 and the file exist, then it is considered as downloaded correctly
DownloadFileA = (returnValue = 0) And (Len(Dir(DownloadPath)) > 0)
Exit Function
Failed:
End Function

Related

Excel VBA - Scrape Google using XMLHTTP (MSXML2.XMLHTTP)

I am trying to pull together a daily table of events for certain news topics on Google News.
In a single module I have the following:
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
Sub Go()
Dim url As String, i As Integer, numb_H3 As Integer, lastRow As Long, XMLHTTP As Object, html As Object, objResultDiv As Object, objH3 As Object, link As Object, j1 As Object
url = "https://www.google.co.uk/search?q=" & "Wearables" & "&tbm=nws" ' "&rnd=" & WorksheetFunction.RandBetween(1, 10000)
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
XMLHTTP.Open "GET", url, False
XMLHTTP.setRequestHeader "Content-Type", "text/xml"
XMLHTTP.send
Set html = CreateObject("htmlfile")
html.body.innerHTML = XMLHTTP.ResponseText
Set objResultDiv = html.getElementById("rso")
numb_H3 = objResultDiv.GetElementsByTagname("H3").Length
For i = 0 To numb_H3 - 1
If numb_H3 > 0 Then
Set objH3 = objResultDiv.GetElementsByTagname("H3")(i)
Set link = objH3.GetElementsByTagname("a")(0)
'get thumbnail image location
Cells(ActiveCell.Row + i, 1).Value = objResultDiv.GetElementsByTagname("img")(i).src
'get news title
Cells(ActiveCell.Row + i, 2).Value = objH3.InnerText
'get news link
Cells(ActiveCell.Row + i, 3).Value = link.href
'get source name
Cells(ActiveCell.Row + i, 5).Value = "need help"
'get source time
Cells(ActiveCell.Row + i, 6).Value = "need help"
'get news paragraph
Cells(ActiveCell.Row + i, 7).Value = "need help"
End If
DoEvents
Next i
html.Close
End Sub
I am able to return the following objects:
I know where the objects are in red that I am trying to get, I'm just struggling with the syntax when using GetElementsByClassName :
so for example, I know that the text "ZDNet" lies in:
?...GetElementsByClassName("slp")(i).GetElementsByTagname("span")(0).InnerText
And that the date "7 Jan 2017" lies in:
?...GetElementsByClassName("slp")(i).GetElementsByTagname("span")(2).InnerText
But I can't get the correct syntax.
I'm hoping I've made a really simple mistake, but I am also open to other methods if they are more efficient.
Thanks for reading,
Mr. J

Having issues migrating data with attachments in Access

All,
I have an MS Access database that has some file attachments that I need to programmatically copy to another MS Access table (both tables are linked tables to a SharePoint 2007 list). I have the following code.
Private Sub AddAttachments(rsSource As Recordset, rsDest As Recordset)
Dim rs2Source As Recordset2
Dim rs2Dest As Recordset2
Set rs2Source = rsSource.Fields!Attachments.Value
Set rs2Dest = rsDest.Fields("Attachments").Value
rs2Source.MoveFirst
If Not (rs2Source.BOF And rs2Source.EOF) Then
While Not rs2Source.EOF
rs2Dest.AddNew
rs2Dest!FileData = rs2Source!FileData
rs2Dest.Update
rs2Source.MoveNext
Wend
End If
Set rs2Source = Nothing
Set rs2Dest = Nothing
End Sub
My issue is that when it gets to rs2Dest!FileData = rs2Source!FileData, it keeps giving me an Invalid Argument error. So, if what I am trying to do is possible, how can I adjust my code to read the attachment data from one list and import it into the other list (both linked as linked-tables in an instance of MS Access).
Thanks in advance.
All,
Here is the clunky solution I came up with in case it helps someone else.
First, I needed to access the URLmon library's URLDownloadToFileA function.
Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, ByVal szURL As String, ByVal szfilename As String, ByVal dwreserved As Long, ByVal ipfnCB As Long) As Long
Then, I would use this library to download the file to my disk, upload from my disk, and delete the temporarily stored file as follows:
Private Function DownloadFile(URL As String, LocalFilename As String) As Boolean
DownloadFile = (URLDownloadToFileA(0, URL, LocalFilename, 0, 0) = 0)
End Function
Private Function GetRight(strText As String, FindText As String) As String
Dim i As Long
For i = Len(strText) - Len(FindText) + 1 To 1 Step -1
If Mid(strText, i, Len(FindText)) = FindText Then
GetRight = Mid(strText, i + 1, Len(strText))
Exit For
End If
Next i
End Function
Private Sub AddAttachments(rsSource As Recordset, rsDest As Recordset)
Dim rs2Source As Recordset2
Dim rs2Dest As Recordset2
Set rs2Source = rsSource.Fields!Attachments.Value
Set rs2Dest = rsDest.Fields("Attachments").Value
Dim strDownload As String
Dim strTemp As String
strTemp = Environ$("TEMP")
If Not (rs2Source.BOF And rs2Source.EOF) Then
rs2Source.MoveFirst
If Not (rs2Source.BOF And rs2Source.EOF) Then
While Not rs2Source.EOF
rs2Dest.AddNew
'rs2Dest.Update
'rs2Dest.MoveLast
'rs2Dest.Edit
strDownload = strTemp & "\" & GetRight(rs2Source!FileURL, "/")
Debug.Print DownloadFile(rs2Source!FileURL, strDownload)
rs2Dest.Fields("FileData").LoadFromFile strDownload
rs2Dest.Update
rs2Source.MoveNext
Kill strDownload 'delete the temporarily stored file
Wend
End If
End If
Set rs2Source = Nothing
Set rs2Dest = Nothing
End Sub
I'm sure there's an easier way, but this seem to work for my purposes (albeit in a clunky fashion that is only fitting for the likes of VBA).

WScript Command - Run Minimized? (MSAccess/VBA)

I am performing a quick PING against the user-selected server IP to confirm it is reachable.
The following code does exactly what I need, except I would like to avoid the quick flash of the Command Shell window.
What do I need to modify to minimize that pesky CMD window?
SystemReachable (myIP)
If InStr(myStatus, "Reply") > 0 Then
' IP is Confirmed Reachable
Else
' IP is Not Reachable
End If
''''''''''''''''''''''
Function SystemReachable(ByVal strIP As String)
Dim oShell, oExec As Variant
Dim strText, strCmd As String
strText = ""
strCmd = "ping -n 1 -w 1000 " & strIP
Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec(strCmd)
Do While Not oExec.StdOut.AtEndOfStream
strText = oExec.StdOut.ReadLine()
If InStr(strText, "Reply") > 0 Then
myStatus = strText
Exit Do
Else
myStatus = ""
End If
Loop
End Function
This question may be a little old but I figure that this answer may still be able to help.
(Tested with Excel VBA, have not been able to test with Access)
The WshShell.Exec Method enables the use of .StdIn, .StdOut, and .StdErr functions to write to and read from the consol window.
The WshShell.Run Method does not allow this functionality so for some purposes using Exec is required.
While it's true that there is no built in function to start the Exec method minimized or hidden you can use API's to quickly find the Exec window hwnd and minize/hide it.
My below script takes the ProcessID from the Exec object to find the window's Hwnd. With the Hwnd you can then set the window's show state.
From my testing with Excel 2007 VBA, in most cases I never even see the window... In some cases it might be visible for a few milliseconds but would only appear a quick flicker or blink... Note: I had better results using SW_MINIMIZE than I did with SW_HIDE, but you can play around with it.
I added the TestRoutine Sub to show an example of how to use the 'HideWindow' function.
The 'HideWindow' function uses the 'GetHwndFromProcess' function to get the window hwnd from the ProcessID.
Place the below into a Module...
Option Explicit
' ShowWindow() Commands
Public Const SW_HIDE = 0
Public Const SW_MINIMIZE = 6
'GetWindow Constants
Public Const GW_CHILD = 5
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
Public Const GW_HWNDPREV = 3
Public Const GW_OWNER = 4
' API Functions
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Sub TestRoutine()
Dim objShell As Object
Dim oExec As Object
Dim strResults As String
Set objShell = CreateObject("WScript.Shell")
Set oExec = objShell.Exec("CMD /K")
Call HideWindow(oExec.ProcessID)
With oExec
.StdIn.WriteLine "Ping 127.0.0.1"
.StdIn.WriteLine "ipconfig /all"
.StdIn.WriteLine "exit"
Do Until .StdOut.AtEndOfStream
strResults = strResults & vbCrLf & .StdOut.ReadLine
DoEvents
Loop
End With
Set oExec = Nothing
Debug.Print strResults
End Sub
Function HideWindow(iProcessID)
Dim lngWinHwnd As Long
Do
lngWinHwnd = GetHwndFromProcess(CLng(iProcessID))
DoEvents
Loop While lngWinHwnd = 0
HideWindow = ShowWindow(lngWinHwnd, SW_MINIMIZE)
End Function
Function GetHwndFromProcess(p_lngProcessId As Long) As Long
Dim lngDesktop As Long
Dim lngChild As Long
Dim lngChildProcessID As Long
On Error Resume Next
lngDesktop = GetDesktopWindow()
lngChild = GetWindow(lngDesktop, GW_CHILD)
Do While lngChild <> 0
Call GetWindowThreadProcessId(lngChild, lngChildProcessID)
If lngChildProcessID = p_lngProcessId Then
GetHwndFromProcess = lngChild
Exit Do
End If
lngChild = GetWindow(lngChild, GW_HWNDNEXT)
Loop
On Error GoTo 0
End Function
ShowWindow function:
http://msdn.microsoft.com/en-us/library/windows/desktop/ms633548%28v=vs.85%29.aspx
GetWindow function:
http://msdn.microsoft.com/en-us/library/windows/desktop/ms633515%28v=vs.85%29.aspx
GetDesktopWindow function:
http://msdn.microsoft.com/en-us/library/windows/desktop/ms633504%28v=vs.85%29.aspx
GetWindowThreadProcessId function:
http://msdn.microsoft.com/en-us/library/windows/desktop/ms633522%28v=vs.85%29.aspx
If you need more information on how the API's work, a quick google search will provide you with a ton of information.
I hope that this can help... Thank You.
Found a very workable and silent approach:
Dim strCommand as string
Dim strPing As String
strCommand = "%ComSpec% /C %SystemRoot%\system32\ping.exe -n 1 -w 500 " & myIP & " | " & "%SystemRoot%\system32\find.exe /i " & Chr(34) & "TTL=" & Chr(34)
strPing = fShellRun(strCommand)
If strPing = "" Then
MsgBox "Not Connected"
Else
MsgBox "Connected!"
End If
'''''''''''''''''''''''''''
Function fShellRun(sCommandStringToExecute)
' This function will accept a string as a DOS command to execute.
' It will then execute the command in a shell, and capture the output into a file.
' That file is then read in and its contents are returned as the value the function returns.
' "myIP" is a user-selected global variable
Dim oShellObject, oFileSystemObject, sShellRndTmpFile
Dim oShellOutputFileToRead, iErr
Set oShellObject = CreateObject("Wscript.Shell")
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
sShellRndTmpFile = oShellObject.ExpandEnvironmentStrings("%temp%") & oFileSystemObject.GetTempName
On Error Resume Next
oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True
iErr = Err.Number
On Error GoTo 0
If iErr <> 0 Then
fShellRun = ""
Exit Function
End If
On Error GoTo err_skip
fShellRun = oFileSystemObject.OpenTextFile(sShellRndTmpFile, 1).ReadAll
oFileSystemObject.DeleteFile sShellRndTmpFile, True
Exit Function
err_skip:
fShellRun = ""
oFileSystemObject.DeleteFile sShellRndTmpFile, True
End Function
the run method of wscript already contains argumewnts to run minimized. So without all that effort shown above simply use
old code
oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 0, True
new code
oShellObject.Run sCommandStringToExecute & " > " & sShellRndTmpFile, 7, True
see Microsoft help for using the run method in wscript.
regards
Ytracks

data type mismatch in FtpFindFirstFile

I am enumerating an ftp directory using the following function:
Public Sub EnumFiles(hConnect As Long)
Const cstrProcedure = "EnumFiles"
Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
Dim strSubCode As String
Dim sql As String
On Error GoTo HandleError
sql = "INSERT INTO tblIncomingFiles (AvailableFile) Values ('" & pData.cFileName & "')"
'get sub code to search with
strSubCode = GetSubscriberCode
'create a buffer
pData.cFileName = String(MAX_PATH, 0)
'find the first file
hFind = FtpFindFirstFile(hConnect, "*" & strSubCode & "*", pData, 0, 0)
'if there's no file, then exit sub
If hFind = 0 Then Exit Sub
'show the filename
Debug.Print Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
CurrentDb.Execute sql
Do
'create a buffer
pData.cFileName = String(MAX_PATH, 0)
'find the next file
'lRet = FtpFindNextFile(hFind, pData.cFileName)
'if there's no next file, exit do
If lRet = 0 Then Exit Do
'show the filename
'Me.Print Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
CurrentDb.Execute sql
Loop
'close the search handle
HandleExit:
Exit Sub
HandleError:
ErrorHandle Err, Erl(), cstrModule & "." & cstrProcedure
Resume HandleExit
End Sub
I keep getting a Data type mismatch (Error 13) in this line:
hFind = FtpFindFirstFile(hConnect, "*" & strSubCode & "*", pData, 0, 0)
and it highlights pData.
I have declared pData as WIN32_FIND_DATA at the top of the function, and WIN32_FIND_DATA is declared as a type in this module.
Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal sSearchFile As String, ByVal lpFindFileData As Long, _
ByVal lFlags As Long, ByVal dwContext As Long) As Long
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Any idea why I might be getting that error?
I have a working example that I found here, and my FtpFindFirstFile declaration is slightly different from yours. Mine is
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, _
ByVal dwFlags As Long, ByVal dwContent As Long) As Long

How to download all links in column A in a folder? [duplicate]

This question already has answers here:
Closed 10 years ago.
Possible Duplicate:
GET pictures from a url and then rename the picture
I have over 30+ files links I need to download.
Is there a way to do this excel?
I want to do in excel because to get those 30+ links I have to do some clean ups which I do in excel.
I need to do this every day. if there is way to do in excel would be awesome.
For example, if A2 is image then download this image into folder
https://www.google.com/images/srpr/logo3w.png
if there is way to rename logo3w.png to whatever is in B2 that would be even more awesome so I won't have to rename file.
Script below, I found online, It works but I need help with rename it.
In column A2:down I have all links
In column B2:down I have filename with extension
Const TargetFolder = "C:\Temp\"
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
Sub Test()
For Each Hyperlink In ActiveSheet.Hyperlinks
For N = Len(Hyperlink.Address) To 1 Step -1
If Mid(Hyperlink.Address, N, 1) <> "/" Then
LocalFileName = Mid(Hyperlink.Address, N, 1) & LocalFileName
Else
Exit For
End If
Next N
Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
Next Hyperlink
End Sub
Sub HTTPDownloadFile(ByVal URL As String, ByVal LocalFileName As String)
Dim Res As Long
On Error Resume Next
Kill LocalFileName
On Error GoTo 0
Res = URLDownloadToFile(0&, URL, LocalFileName, 0&, 0&)
End Sub
I'm pretty sure you'll be able to slightly modify the following code to satisfy your needs:
Sub DownloadCSV()
Dim myURL As String
myURL = "http://pic.dhe.ibm.com/infocenter/tivihelp/v41r1/topic/com.ibm.ismsaas.doc/reference/LicenseImportSample.csv"
Dim WinHTTPReq As Object
Set WinHTTPReq = CreateObject("Microsoft.XMLHTTP")
Call WinHTTPReq.Open("GET", myURL, False)
WinHTTPReq.send
If WinHTTPReq.Status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHTTPReq.responseBody
oStream.SaveToFile ("D:\DOCUMENTS\timelog.csv")
oStream.Close
End If
End Sub
Good luck!
This should work for you. It will download and rename with the filename that is in column B. I just replaced the 2nd for loop with a line. Hyperlink.range.row gives the row number in which the hyperlink is present. So cells(hyperlink.range.row,2) evaluates to cells(1,2), cells(2,2) and so on (if the data is in A1, A2, A3..). Assuming that you have filename with extension (ex - xyz.png) in column B, this should work.
Const TargetFolder = "C:\Temp\"
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
Sub Test()
For Each Hyperlink In ActiveSheet.Hyperlinks
LocalFileName=ActiveSheet.cells(hyperlink.Range.Row,2).value
Call HTTPDownloadFile(Hyperlink.Address, TargetFolder & LocalFileName)
Next Hyperlink
End Sub
Sub HTTPDownloadFile(ByVal URL As String, ByVal LocalFileName As String)
Dim Res As Long
On Error Resume Next
Kill LocalFileName
On Error GoTo 0
Res = URLDownloadToFile(0&, URL, LocalFileName, 0&, 0&)
End Sub
Let me know if this helps.