Access vba - webGetFolder

[jcsabi]

Hello,

I've a web connection for downloading access databases (then transport tables to a .csv file). At the moment I get the web file structure from a datatable (fields contain the foldernames). But it's changing weekly so It would be nice to get the actual web subfolder structure and files, similar as the scripting.filesystemobject - GetFolder method.
Is it possible?

Thanks,
Csaba


Sub DownloadFiles()
On Error GoTo ErrorHandler
Dim i, url, src, trg, regio, telep, Filename
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("SELECT * FROM [TELEP];")

i = 1
url = "http:/.../"
ChDrive ("D:")
ChDir "D:\Adatok\3.2\"
Temp = SysCmd(acSysCmdSetStatus, "Download..")
Do While Not rs.EOF
src = rs.Fields(0) & " " & rs.Fields(1) & " " & rs.Fields(2)
Temp = SysCmd(acSysCmdSetStatus, src)
telep = rs.Fields(2).Value
regio = rs.Fields(1).Value
Filename = telep & "_20120830.mdb"
src = url & rs.Fields(0) & "/" & regio & "/" & telep & "/" & Filename
trg = "D:\Adatok\3.2\" & Filename
If SaveWebFile(src, trg) Then Temp = SysCmd(acSysCmdSetStatus, telep)
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set db = Nothing
Exit Sub

ErrorHandler: ' Error-handling routine.
Debug.Print "Hiba! " & _
vbCrLf & Err.Description & _
vbCrLf & Err.Number & _
vbCrLf & src & _
vbCrLf & trg

Resume Next ' Resume execution at same line that caused the error.
End Sub

Function SaveWebFile(ByVal vWebFile As String, ByVal vLocalFile As String) As Boolean
Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte

'You can also set a ref. to Microsoft XML, and Dim oXMLHTTP as MSXML2.XMLHTTP
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", vWebFile, False 'Open socket to get the website
oXMLHTTP.Send 'send request

'Wait for request to finish
Do While oXMLHTTP.readyState <> 4
DoEvents
Loop

oResp = oXMLHTTP.responseBody 'Returns the results as a byte array

'Create local file and save results to it
vFF = FreeFile
If Dir(vLocalFile) <> "" Then Kill vLocalFile
Open vLocalFile For Binary As #vFF
Put #vFF, , oResp
Close #vFF

'Clear memory
Set oXMLHTTP = Nothing
End Function