94451
94451
Feb 22, 2016, updated at 21:48:52 (UTC)
view1787
view5
0
Goto Top

(VBA) read from TCP

GermansolvedQuestionVB for ApplicationsDevelopment
Hi,

ich habe einen kleinen Arduino-Server der mir über TCP/HTTP (eine IP im localen Netz) datenzurückgibt.
Jetzt wollte ich fragen ob es möglich ist über VBA diese Daten abzurufen?

Sozusagen hätte ich gerne einen Button und der holt sich dann einfach alle Daten von 192.168.1.55

=> chrome gibt mir das zurück:
view-source:192.168.1.55
{20.81,20.87,21.31,21.12,20.69}

sobald das mal in Excel ist das umzuformatieren sollte kein Problem darstellen... die Frage ist wie bekomm ich das in Excel rein?

Vielen Dank
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 297030

Url: https://administrator.de/contentid/297030

Printed on: April 20, 2024 at 05:04 o'clock

5 Comments
Latest comment
Goto Top
Member: colinardo
colinardo Feb 22, 2016 updated at 18:11:25 (UTC)
Goto Top
Hallo RoadRunner777,
wenn deine Seite wirklich nur Text zurückgibt, kannst du es z.B. so machen.
Sub GetData()
    dim lngTicks as Long
    lngTicks = DateDiff("s",#1970/1/1#,now())  
    ' URL angeben  
    Const URL = "http://192.168.1.55"  
    'URL abrufen (damit keine gecachte Antwort zurückgegeben wird das Anhängen eines Tick-Wertes)  
    MsgBox GetUrlResponse(URL & "?" & lngTicks)  
End Sub

'Function zum holen der Daten per XMLHTTP-Object  
Function GetUrlResponse(ByVal strURL As String) As String
    On Error GoTo Error
    Dim objhttp As Object
    Set objhttp = CreateObject("Microsoft.XMLHTTP")  
    With objhttp
        .Open "GET", strURL, False  
        .send
        If .Status = 200 Then
            GetUrlResponse = .responseText
        Else
            GetUrlResponse = ""  
        End If
    End With
    Exit Function
Error:
    GetUrlResponse = ""  
End Function
Je nach dem wie die Daten zurückgeliefert werden ist eventuell Anpassung nötig.

Grüße Uwe
Member: miniversum
miniversum Feb 22, 2016 at 18:07:47 (UTC)
Goto Top
Wenn du view-source verwendest dann willst du ja eigentlich den Inhalt der html Datei lesen.
Dazu findest du sicher was.

Wenn du allerdings wirklich einen interpreter brauchst vorher dann würd ich das Microsoft Web Browser Steuerelement auf eine Form setzen und dann "von hinten" anzapfen und verwenden.
Mitglied: 94451
94451 Feb 22, 2016 at 18:18:03 (UTC)
Goto Top
Sehr sehr geil...

erste Zeile musste ich noch vür x64 anpassen:
Private Declare PtrSafe Function GetTickCount64 Lib "kernel32" () As LongLong
Mitglied: 94451
94451 Feb 22, 2016 updated at 18:36:30 (UTC)
Goto Top
evtl. kann mir noch jemand sagen wie ich das jetzt in eine schleife bringe...

zwar habe ich schon mir dieses Script aus dem Internet geholt...
Sub start()
  dblNextTime = Now + TimeSerial(0, 0, 1)
  Application.OnTime dblNextTime, "Uhrzeit"  
End Sub

Sub stopp()
  Application.OnTime dblNextTime, "Uhrzeit", Schedule:=False  
End Sub

Sub Uhrzeit()
  Debug.Print Format(Time, "hh:mm:ss")  
  start
End Sub

und während start ganz gut geht... kommt bei STOP immer Fehler 1004...

Ich nutze Office 2016 x64
Member: colinardo
Solution colinardo Feb 22, 2016 updated at 21:48:51 (UTC)
Goto Top
Setze einfach eine globale Variable im Modulkontext welche du in deiner Prozedur auf True oder False prüfst und je nachdem Application.OnTime wieder setzt oder nicht.

Public timerActive As Boolean

Sub GetData()
    Dim lngTicks As Long
    lngTicks = DateDiff("s", #1/1/1970#, Now())  
    ' URL angeben  
    Const URL = "http://192.168.1.55"  

    If timerActive Then
        'URL abrufen (damit keine gecachte Antwort zurückgegeben wird das Anhängen eines Tick-Wertes)  
       Sheets(1).Range("A1") = Format(Now, "hh:mm:ss")          
       Sheets(1).Range("B1").Value = GetUrlResponse(URL & "?" & lngTicks)  
         
        ET = Now + TimeValue("00:00:01")  
        Application.OnTime ET, "GetData"  
    End If
End Sub

'Function zum holen der Daten per XMLHTTP-Object  
Function GetUrlResponse(ByVal strURL As String) As String
    On Error GoTo Error
    Dim objhttp As Object
    Set objhttp = CreateObject("Microsoft.XMLHTTP")  
    With objhttp
        .Open "GET", strURL, False  
        .send
        If .Status = 200 Then
            GetUrlResponse = .responseText
        Else
            GetUrlResponse = ""  
        End If
    End With
    Exit Function
Error:
    GetUrlResponse = ""  
End Function

'Prozedur zum Starten  
Sub StartTimer()
    timerActive = True
    GetData
End Sub

'Prozedur zum Stoppen  
Sub StopTimer()
    timerActive = False
End Sub
Wenns das dann war, den Beitrag bitte noch auf gelöst setzen. Merci.

Grüße Uwe
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 3 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment