Newsgroup: it.comp.lang.visual-basic
Titolo: Problemi con VBA e ServerXMLHTTP 4.0

Salve,
sto cercando di recuperare dei valori con Access e VBA da un sito web
tramite XmlServer 4.0 ma a volte l'oggetto, tramite il metodo
.responseText, non mi restituisce nulla.
pls reply to "cobra 82 @ libero . it"
Vi allego il codice 
************************************************************************************************************************************************************************************************************************
Option Compare Database
Private Sub ControllaDomini()
On Error GoTo Err_ControllaDomini
 
    DoCmd.Hourglass True
 
    Dim dbs As Database
    Dim rst As Recordset
    Dim strSQL As String
 
    Set dbs = CurrentDb()
    strSQL = "SELECT Domini.*, ServerWhois.strServer FROM Domini INNER
JOIN ServerWhois ON Domini.idServerWhois = ServerWhois.idServer;"
    Set rst = dbs.OpenRecordset(strSQL)
 
    If (rst.EOF) Then
        MsgBox "Nessun Record."
    Else
        While (Not (rst.EOF))
            If CDate(rst.Fields.Item("LastCheck").Value) <> CDate(Now)
Then
                strHtmlResponse = ""
                While strHtmlResponse = ""
                    strHtmlResponse =
GetDomainInfo(rst.Fields.Item("Dominio").Value,
rst.Fields.Item("strServer").Value)
                Wend
                rst.Edit
                rst.Fields.Item("DataRegistrazione").Value =
GetDomainDetail(strHtmlResponse, "creat")
                rst.Fields.Item("DataScadenza").Value =
GetDomainDetail(strHtmlResponse, "expir")
                If (rst.Fields.Item("DataRegistrazione").Value <>
"Unknown") _
                    And (rst.Fields.Item("DataScadenza").Value <>
"Unknown") Then
                        rst.Fields.Item("LastCheck").Value = Now()
                End If
                rst.Update
                DoCmd.Requery
 
            End If
            rst.MoveNext
        Wend
    End If
    ' Close the recordset and the database.
    rst.Close
    dbs.Close
Exit_ControllaDomini:
    DoCmd.Hourglass False
    Exit Sub
Err_ControllaDomini:
    MsgBox Err.Description
    Resume Exit_ControllaDomini
 
End Sub
    Function GetDomainInfo(strDomain, strServer)
        Dim serverXMLHTTP, sXMLStream
 
        Set serverXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.4.0")
 
        strURL = "
http://we.register.it/whoisit2.html?query=
" &
strDomain & "&server=" & strServer
 
        serverXMLHTTP.Open "GET", strURL, False
        serverXMLHTTP.Send
 
        If serverXMLHTTP.Status = 200 Then
            sXMLStream = serverXMLHTTP.responseText   ' Retrieve from
serverB.
        End If
        GetDomainInfo = sXMLStream
        serverXMLHTTP.abort
        Set serverXMLHTTP = Nothing
 
    End Function
    Function GetDomainDetail(strHtmlResponse, strParam)
        HTML_lines = Split(strHtmlResponse, vbLf)
        Dim strValue
        trov = False
        For i = LBound(HTML_lines) To UBound(HTML_lines)
            Line = Trim(HTML_lines(i))
            If InStr(Line, strParam) > 0 Then
               trov = True
               Exit For
            End If
        Next
 
        If trov Then
            Line = Trim(HTML_lines(i))
             strValue = Line
        End If
 
        If strValue = "" Then strValue = "Unknown"
        GetDomainDetail = strValue
    End Function
Private Sub Comando1_Click()
   Call ControllaDomini
End Sub
************************************************************************************************************************************************************************************************************************
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 .responseText, non mi restituisce nulla.
Hai dei valori di ritorno in .Status e .StatusText?
Saluti.

"Gabriele Del Giovine" <x@x.x> wrote in message
news:bihrq5$2cv9$
1...@newsreader1.mclink.it

Si mi .Status ritorna 200
comunque ho notato che era il fatto che fosse tutto in un coclo e ho
risolto mettendo in pausa :
        Dim PauseTime, Start, Finish, TotalTime
        PauseTime = 5    ' Imposta la durata.
        Start = Timer    ' Imposta l'ora di inizio.
        Do While Timer < Start + PauseTime
            DoEvents        ' Passa il controllo ad altri processi.
        Loop
        Finish = Timer    ' Imposta l'ora di fine della pausa.
        TotalTime = Finish - Start    ' Calcola il tempo totale.
Grazie comunque
Ciao
