File Saving macro ?!?!
 

Hi All,

want to make a simple macro here. I have a list of cells what each has
a weblink to a file. I want to make a Macro that will download each
linked file into a directory on my PC. is this possible :confused:

simple execution:
active cell will start at "A1", there will be a web-link as the value
for the cell and i want the file for the web-link saved directly to a
directory on my c-drive. it will work it's way down until the
activecell is empty.


Regards
Hemant


--
hemants
------------------------------------------------------------------------
hemants's Profile: http://www.excelforum.com/member.php...o&userid=15031
View this thread: http://www.excelforum.com/showthread...hreadid=574423

File Saving macro ?!?!
 

Hement

This is some code I found on the net ages ago with some additional bits
to loop you through column A.

You will need to set correct parramaters for the sLocalFile variable.
This is the full path and file name for where the downloaded file is to
be saved to



Option Explicit


'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' Copyright ©1996-2003 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''
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

Private Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000



Sub AutoDownloadIntranetFile(Optional bReportOnly As Boolean)
Dim sSourceUrl As String
Dim sDate As String

Dim i4Row As Integer
Dim iLastRow As Integer

iLastRow = Cells(Rows.Count, "a").End(xlUp).Row
For i4Row = 1 To iLastRow Step -1
sSourceUrl = Cells(i4Row, "a")
sLocalFile = Cells(i4Row, "b")

If Dir(sLocalFile) < "" Then
Kill sLocalFile
End If
If DownloadFile(sSourceUrl, sLocalFile) = False Then
MsgBox "Error In Downloading File" _
& Chr(10) _
& "Cannot Continue", vbCritical
End
End If
Next i4Row
End Sub


Public Function DownloadFile(sSourceUrl As String, _
sLocalFile As String) As Boolean

'Download the file. BINDF_GETNEWESTVERSION forces
'the API to download from the specified source.
'Passing 0& as dwReserved causes the locally-cached
'copy to be downloaded, if available. If the API
'returns ERROR_SUCCESS (0), DownloadFile returns True.
DownloadFile = URLDownloadToFile(0&, _
sSourceUrl, sLocalFile, _
BINDF_GETNEWESTVERSION, _
0&) = ERROR_SUCCESS
End Function


--
mudraker
------------------------------------------------------------------------
mudraker's Profile: http://www.excelforum.com/member.php...fo&userid=2473
View this thread: http://www.excelforum.com/showthread...hreadid=574423