Zum Inhalt springen

VB: Dokument/URL geöffnet?


heipa

Empfohlene Beiträge

Hallo zusammen,

ich habe folgendes Problem:

Ich habe eine Datenbank, in der mehrere Einträge zum Speicherort stehen. LAN-Adressen und URL's... Es können jeweils unendlich verschiedene Speicherorte angegeben werden.

Die Reihenfolge ist, zuerst die LAN-Orte öffnen, anschliessend die URLs.

Wie ich eine Addy öffne, ist im Prinzip ja kein Problem:


Private Sub btnOpen_Click()

    Dim tmpRS As Recordset

    Dim tmpLBRS As Recordset

    Dim path As String

    Dim newPath

    Dim file As String


    If Not tabDocSel.RowSel Then

        Set rs = TQM_ADO.findByName("TQM_DKD_DokumentenDaten", "DKD_Dokumentenname", tabDocSel.TextMatrix(tabDocSel.RowSel, 1))

        If Not rs.BOF And Not rs.EOF Then

            TQM_ADO.closeRS

            Set tmpRS = TQM_ADO.findByPrimaryKey("TQM_SOL_SpeicherortLan", "SOL_DKD_LfDNr", rs!DKD_LfDNr)

            If Not tmpRS.BOF And Not tmpRS.EOF Then

                Do While Not tmpRS.EOF

                    On Error Resume Next

                    path = Trim(Left(Trim(tmpRS!SOL_String), InStrRev(Trim(tmpRS!SOL_String), "\")))

                    file = Trim(Right(tmpRS!SOL_String, Len(tmpRS!SOL_String) - InStrRev(Trim(tmpRS!SOL_String), "\")))

                    path = Trim(Right(path, Len(path) - 1))

                    newPath = path

                    TQM_ADO.closeRS

                    Set tmpLBRS = TQM_ADO.findAll("TQM_DIR_Directory", "DIR_Prioritaet")

                    Do While Not tmpLBRS.EOF

                        newPath = Trim(tmpLBRS!DIR_Pfad) & newPath

                        Call ShellExecute(Me.hwnd, "Open", file, "", newPath, 1)

                        newPath = path

                        tmpLBRS.MoveNext

                    Loop

                    Set tmpLBRS = Nothing

                    tmpRS.MoveNext

                    On Error GoTo 0

                Loop

            End If

            Set tmpRS = Nothing

            TQM_ADO.closeRS

        End If

        Set tmpRS = TQM_ADO.findByPrimaryKey("TQM_SOU_SpeicherortUrl", "SOU_DKD_LfDNr", rs!DKD_LfDNr)

        If Not tmpRS.BOF And Not tmpRS.EOF Then

            Do While Not tmpRS.EOF

                On Error Resume Next

                msgInfo (Trim(tmpRS!SOU_String))

                Call ShellExecute(Me.hwnd, "Open", Trim(tmpRS!SOU_String), "", App.path, 1)

                tmpRS.MoveNext

                On Error GoTo 0

            Loop

        End If

        Set tmpRS = Nothing


    End If

    Set rs = Nothing

End Sub

So sieht mein Code bisher aus. Nun möchte ich aber, dass mein Dokument bei mehreren Einträgen, nur einmal geöffnet wird obwohl es möglich ist, dass auch alle Dokumente geöffnet werden könnten. Also er soll nachdem das 1. Dokument geöffnet ist, die Prozedur abbrechen.

Nun meine Frage, muss ich jetzt nach jedem Durchlauf testen, ob die Sache schon ausgeführt ist oder gibt es da nicht eine schönere, einfachere Lösung?

Danke für Eure Hilfe!!!

MfG,

Patrick

Link zu diesem Kommentar
Auf anderen Seiten teilen

Hallo,

habe die Lösung selber gefunden...

für alle die sie interessiert:


Public Function isFileOpen(ByRef Path As String) As Boolean

    Dim fileNr As Integer

    Dim errorNr As Long


    On Error Resume Next

        fileNr = FreeFile

        Open Path For Input Lock Write As #fileNr

            errorNr = Err.Number

        Close #fileNr

    On Error GoTo 0


    Select Case errorNr

        Case 0

        Case 70

            isFileOpen = True

        Case Else

            Err.Raise errorNr

    End Select

End Function

Danke trotzdem für die Hilfe...

Patrick

Link zu diesem Kommentar
Auf anderen Seiten teilen

Gast
Dieses Thema wurde nun für weitere Antworten gesperrt.

Fachinformatiker.de, 2024 by SE Internet Services

fidelogo_small.png

Schicke uns eine Nachricht!

Fachinformatiker.de ist die größte IT-Community
rund um Ausbildung, Job, Weiterbildung für IT-Fachkräfte.

Fachinformatiker.de App

Download on the App Store
Get it on Google Play

Kontakt

Hier werben?
Oder sende eine E-Mail an

Social media u. feeds

Jobboard für Fachinformatiker und IT-Fachkräfte

×
×
  • Neu erstellen...