For each line+download+Wait Download 1

[CharlesFS]

Hi, i don`t know how but i need a way to make one code to:

* For each line in table name "resposta" get column "link" value and execute this link(all the links contain files like 300kb~400kb)

* How make vba wait the download complete to continue the routine?


thanks a lot!

 

[CharlesFS]

First: how use "for each record" in table?
I need to use count?

 

[PHV]

Use a Recordset.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[CharlesFS]

I have this(by google):

Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("resposta")
Dim link As Variant
    With Rst
    Do
         
        .MoveNext
    Loop Until .EOF
End With
End Sub

I tried to use Dlookup to get field value as:

Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("resposta")
Dim link As Variant
    With Rst
    Do
    Link=Dlookup("[linkfield]", "resposta", "")
    msgbox link 
   .MoveNext
    Loop Until .EOF
End With
End Sub

Obvious, not work because dlookup send the first value of the "link" field in table all the time.

How get the field value from recordset in this case?

 

[PHV]

Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("resposta")
Dim link As Variant
With Rst
  .MoveFirst
  While Not .EOF
    link = ![linkfield]
    MsgBox link 
   .MoveNext
  WEnd
End With
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[CharlesFS]

PHP thanks!

Now the download question, i have this code but my links dont have file name into them (like xxx.xxx.xxx/1234.zip) and i need the original file name. The question:
How get file name by XMLHTTP resquest? or response?

Sub Workbook_Open()
Download_File [b]"[URL unfurl="true"]http://www.bovespa.com.br/dxw/Download.asp?moeda=L&site=B&mercado=18&razao=WEG%20S.A.&pregao=WEG&ccvm=5410&data=30/09/2008&tipo=1"[/URL][/b], Environ("TEMP") & "\originalfilename.*"
End Sub

Function Download_File(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
Dim resposta As String
resposta = oXMLHTTP.responseStream
oResp = oXMLHTTP.responseBody 'Returns the results as a byte array
MsgBox resposta
MsgBox oResp
'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

Thanks a lot PHV! The hero!

 

[CharlesFS]

Yes! I Found the soluction to request files from url`s without the name of file in url, lets share:

Sub LinkDownload()
Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte
Dim Link As String 'Indica o link a ser executado
[red]Link = "[URL unfurl="true"]http://www.bov.com.br/dxw/Download.asp"[/URL][/red] 'Ex.

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

'Wait for request to finish
Do While oXMLHTTP.readyState <> 4
DoEvents
Loop
Dim Dirfile As String
Dirfile = "C:\" 'Dir to send the file

Dim sfilename As String
sfilename = Dirfile & [b]GetFileName(oXMLHTTP.getResponseHeader("Content-Disposition"))[/b]
oResp = oXMLHTTP.responseBody 'Returns the results as a byte array
MsgBox sfilename

'Create local file and save results to it
vFF = FreeFile
If Dir(sfilename) <> "" Then Kill sfilename
Open sfilename For Binary As #vFF
Put #vFF, , oResp
Close #vFF
'Clear memory
Set oXMLHTTP = Nothing
End Sub

Function GetFileName(rsHeader)
Dim rgx As Object
Set rgx = New RegExp
rgx.Pattern = "filename=(?:""([^""]+)""|([^;]+);?)"
rgx.IgnoreCase = True
GetFileName = "Unknown.dat"
Dim oMatch
For Each oMatch In rgx.Execute(rsHeader)
GetFileName = oMatch.SubMatches(0)
If GetFileName = "" Then GetFileName = oMatch.SubMatches(1)
Exit For
Next
End Function

PHV, can you help me with "one more simple question"?
You posted the code:

Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("resposta")
Dim Link As Variant
With Rst
  .MoveFirst
  While Not .EOF
    [blue]Link = ![Link][/blue]
    MsgBox Link
   .MoveNext
  Wend
End With
End Sub

How can i send the blue string value to red string? I think its like a public string but i dont know how.

Thank you.

 

[PHV]

Sub LinkDownload(Link As String)
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", Link, False 'Open socket to get the website
oXMLHTTP.Send 'send request
...
End Sub

Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("resposta")
With Rst
  .MoveFirst
  While Not .EOF
    LinkDownload ![Link]
   .MoveNext
  Wend
End With
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[CharlesFS]

PHV!!!
All working!
Thanks a LOT!