Wie binde ich ein Recordset ein?

Ich habe leider nur begrenztes VBA/VBS wissen..

Hallo,

auf der Seite: http://www.office-loesung.de/ftopic59453_0_0_asc.php

habe ich ein paar Dinge dazu gelesen. Aber verstehe nicht wie ich das in meine Projekt mit einbinden soll.

Ich habe einen Button in jeder Zeile eines Endlosformulars, dieser ist mit einem Code verbunden.

Bisher musste ich für jede Zeile diesen Button klicken damit einzeln für jede zeile der Code ausgeführt wird.
Es handelt sich um eine IP Liste... Jede IP hat einen Button "Ping" mit je Variablen die auf das jeweilige Feld IP verweisen.

Wie kann ich es anstellen das alle, ich sag mal "Buttons" hintereinander gedrückt werden... bzw. der Button Code je Zeile 1mal ausgeführt wird? (Hintereinander)

Habe gelesen das es mit dem im Link beschriebenen verfahren möglich sien soll.. habe nur leider kein verständnis dafür :/

Über Anregungen/Hilfe wär ich sehr Dankbar.
gruß Cyberkey

Im Anhang der Code und Bild:

Private Sub IPall_Click()
Dim strTarget, strPingResults, objShell, objExec
On Error Resume Next
strTarget = Me.IPall 'IP address or hostname  
Set objShell = CreateObject("WScript.Shell")  
Set objExec = objShell.Exec("ping -n 1 -w 5 " & strTarget)  
strPingResults = LCase(objExec.StdOut.ReadAll)
If InStr(strPingResults, "Antwort von") > 0 Then  
    'MsgBox ("Geht")  
    'MsgBox "# " & strPingResults & " #", vbCritical, "Ergebnis"  
    'MsgBox "Ergebnis: " & strPingResults  

    DoCmd.SetWarnings False
    DoCmd.RunSQL "UPDATE Ip_adressen SET Status=1 WHERE IPall='" & strTarget & "'"  
    Me.Refresh
Else
    'MsgBox ("Geht nicht")  
    DoCmd.SetWarnings False
    DoCmd.RunSQL "UPDATE Ip_adressen SET Status=0 WHERE IPall='" & strTarget & "'"  
    Me.Refresh
End If
DoCmd.SetWarnings True
Me!Wake.SetFocus
End Sub

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 139603

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

Ausgedruckt am: 26.11.2024 um 15:11 Uhr

7 Kommentare

Neuester Kommentar

Hallo Cyberkey!

Sinngemäß das Ganze in etwa so:

Option Compare Text

Private Sub Button_Click()
    Dim RS As Object
    
    Set RS = Application.CurrentDb.OpenRecordset("Select * From [Ip_adressen]")  
    
    With RS
        Do Until .EOF
            If Not IsNull(.Fields("IPall")) Then  
                .Edit
                .Fields("Status") = GetPingStatus(.Fields("IPall").Value)  
                .Update
            End If
           .MoveNext
        Loop
    End With
    
    Set RS = Nothing

   'Me.Refresh   
End Sub

Private Function GetPingStatus(ByRef IP) As Long
    Dim objShell As Object, objExec As Object, Result As String
    
    On Error Resume Next
    
    Set objShell = CreateObject("WScript.Shell")  
    Set objExec = objShell.Exec("ping -n 1 -w 5 " & IP)  
    
    Do Until objExec.Status:  Loop  'Warten  
   
    Result = objExec.StdOut.ReadAll
    
    If InStr(Result, "Antwort von") > 0 Then GetPingStatus = 1  
End Function

Gruß Dieter

[edit] Codezeile 32 hinzugefügt, warten bis Ping ausgeführt wurde [/edit]

Wunderbar !! ^^
Danke Dieter !
läuft 1a ;)

Hallo Cyberkey!

Zitat von @Cyberkey:
Wunderbar !! ^^
Danke Dieter !
läuft 1a ;)

Prima! Hast Du die Änderung in Codezeile 32 auch schon mit übernommen?

Gruß Dieter

Hallo Cyberkey!

Im Gegensatz zu VBA-Shell gibt WScript-Shell ja einen Fehlercode zurück, wodurch sich das Ganze etwas optimieren ließe und die DOS-Fenster auch wegfallen.

Private Const PingCmd = "ping -n 1 -w 5 "  

Private Sub Button_Click()
    Dim RS As Object, WshShell As Object
    
    Set WshShell = CreateObject("WScript.Shell")  

    Set RS = Application.CurrentDb.OpenRecordset("Select * From [Ip_adressen]")  
    
    With RS
        Do Until .EOF
            If Not IsNull(.Fields("IPall")) Then  
                .Edit
                .Fields("Status") = WshShell.Run(PingCmd & .Fields("IPall").Value, 0, True) Xor 1  
                .Update
            End If
           .MoveNext
        Loop
    End With
    
    Set RS = Nothing:  Set WshShell = Nothing
End Sub

Wobei sich der Rückgabewert 0=True und 1=False durch ein XOR in 1=True und 0=False umkehren läßt

Gruß Dieter

Hallo Dieter,
das stimmt!
Die Dos Fenster waren wirklich eine sehr unschöne Lösung!

Der Code sieht etwas kompliziert aus @ VBS CODE .. hab ich so nochnie gemacht.

Aber es ist eine gute Lösung!

Danke für die fleißige extra Arbeit^^
gruß Cyberkey

Werde das so bald wie möglich ins Projekt einfügen.

Hallo Dieter,
ich habe noch ein Problem erkannt.
Es wird nicht nach jeder Zeile aktualisiert sondern erst nach dem "Job". vll. bischen buggy.
Desweiteren sieht man nur unten "Berechnung läuft" das etwas passiert.. Ungedultige Nutzer könnten so X mal auf den Button klicken.
Werde den beim Job wohl Deaktivieren müssen.

Gruß Cyberkey

EDIT: das mit dem Button ist gelöst.. blos das ".Update" funktioniert nicht so richtig