Advertisement
Advertisement
| 12.11.2007 at 06:10AM PST, ID: 23015426 |
|
[x]
Attachment Details
|
||
|
[x]
The Solution Rating System
|
||
|
With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.
Your Input Matters If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support. Thank you! |
||
| Microsoft |
| Apple |
| Internet |
| Gamers |
| Digital Living |
| Virus & Spyware |
| Hardware |
| Software |
| ITPro |
| Developer |
| Storage |
| OS |
| Database |
| Security |
| Programming |
| Web Development |
| Networking |
| Other |
| Community Support |
| 12.11.2007 at 06:27AM PST, ID: 20449488 |
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: |
Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
...
Dim bContentIsOk As Boolean
Dim oXMLHTTP As Object ' MSXML2.XMLHTTP26
On Error GoTo errhandle
Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")
bContentIsOk = False
Do Until bContentIsOk
oXMLHTTP.Open "GET", myUrl, False
oXMLHTTP.send
' return bytearray
strhtml = oXMLHTTP.responseText
If InStr(1, strhtml, "this is a string I know is in the redirect page") = 0 Then
bContentIsOk = True
Else
Sleep 10000 'However long the javascript wait is
End If
Loop
Set oXMLHTTP = Nothing
Exit Function
errhandle:
' do something here
Set oXMLHTTP = Nothing
|
| 12.11.2007 at 08:34AM PST, ID: 20450429 |
| 12.11.2007 at 08:57AM PST, ID: 20450644 |
| 12.11.2007 at 11:23AM PST, ID: 20451819 |
| 12.11.2007 at 11:57AM PST, ID: 20452137 |
| 12.11.2007 at 12:04PM PST, ID: 20452205 |
| 12.11.2007 at 01:40PM PST, ID: 20453080 |
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: |
Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private WithEvents http As WinHttpRequest
Private Sub Command1_Click()
Dim myURL As String
Dim strKey As String
Dim Count As Integer
myURL = "http://excel2.smarthouse.de/ExcelWriter.aspx?xls_cu=vontobel&xls_co=productlist&xls_s=derinet-chDE&pageid=40"
Set http = New WinHttpRequest
http.Open "GET", myURL, False
http.Send
myURL = myURL & "&xls_file="
strKey = fParseBetween(http.ResponseText, "location.href = location.href + '&xls_file=", "';")
myURL = myURL & strKey
Do While InStr(1, http.ResponseText, "function redirect()")
Sleep 3000
Count = Count + 1
http.Open "GET", myURL, False
http.Send
Debug.Print Count
Loop
sPutBytesToFile http.ResponseBody, "C:\temp\test2.xls"
MsgBox "Done"
MsgBox FileLen("C:\temp\test2.xls")
End Sub
Public Function fParseBetween(ByVal strChk As String, ByVal strFirst As String, ByVal strLast As String, Optional lngStart As Long = 1) As String
Dim lngPos As Long, lngLen As Long
lngPos = InStr(lngStart, strChk, strFirst, vbTextCompare) + Len(strFirst)
lngLen = InStr(lngPos, strChk, strLast, vbTextCompare) - lngPos
If lngPos > 0 And lngLen > 0 Then
fParseBetween = Mid$(strChk, lngPos, lngLen)
If Len(fParseBetween) > 0 Then
lngStart = lngStart + Len(fParseBetween)
End If
End If
End Function
Public Sub sPutBytesToFile(byt() As Byte, strPath As String)
Dim i As Integer
Dim hFile As Integer
If Dir(strPath) <> "" Then
Kill strPath
End If
hFile = FreeFile
Open strPath For Binary As #hFile
Put #hFile, , byt
Close #hFile
End Sub
|
