Meerdere dingen tegelijk ophalen

[Crizke]

Hoi hoi

Ik heb een functie die verbinding maakt met externe servers. Deze gaat eerst inbellen op server, controleert of deze in aanmerking komt, haalt indien nodig de informatie op en gaat dan verder naar de volgende en doet hier hetzelfde.
Dit doet hij goed, maar neemt nogal veel tijd in beslag omdat hij +/- rond de 200 inbelacties moet doen.

Nu was mijn vraag of er een manier is om mijn functie (die ik hier beneden gezet heb) aan te passen zodat hij de inbelacties doet, even onthoudt welke in aanmerking komen en dan alle informatie tegelijk ophaaltdoet en niet 1 na 1...

Tnx

Public Function SndFilesAll(Programma, Locatie, StationId)

'*** Versturen van bestanden naar CIS
    ActiveDir = Left$(CurrentDb.Name, Len(CurrentDb.Name) - Len(Dir$(CurrentDb.Name)))
    ActiveTmpDir = ActiveDir & "Temp\"

'*** Declaratie
    Dim StrSql As String
    Dim Rst, Rst1, Db

'*** Opvullen systeemwaarden
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Db = CurrentDb

'*** Opvragen van de stations die hiervoor in aanmerking komen

    If Left(Programma, 3) = "WRK" Or Left(Programma, 3) = "Get" Then
        StrSql = "SELECT * FROM TStations, TPrograms, TModules " _
                & "WHERE StIdNr = MoStnr " _
                & "AND PrIdNr = MoProg " _
                & "AND PrNaam = '" & Programma & "'" _
                & "AND StIdNr = " & StationId
    Else
        If StationId = "" Then
            StrSql = "SELECT * FROM QStations, TPrograms, TModules " _
                & "WHERE StIdNr = MoStnr " _
                & "AND PrIdNr = MoProg " _
                & "AND PrNaam = '" & Programma & "'"
        Else
            StrSql = "SELECT * FROM QStations, TPrograms, TModules " _
                & "WHERE StIdNr = MoStnr " _
                & "AND PrIdNr = MoProg " _
                & "AND PrNaam = '" & Programma & "'" _
                & "AND StIdNr = " & StationId
        End If
    End If

    Set Rst = Db.OpenRecordset(StrSql)

    Do While Rst.EOF = False

        Connectie = "Park - " & Rst.StNaam & " (" & Locatie & ")"

        Y0Ping = Rst.StPing
        Y0CVDB = Rst.PrConv
        IPadres = Rst.StFtpA

    '*** Verbinding maken met het station bij Get
        If Rst.PrFunc = "Get" Then
            '*** Verbinding verbreken
            Call Verbreken
            If Programma = "WrkEmis" Then
                Call Verbinden(Connectie, Rst.StEPPId, Rst.StEPPWw, Rst.StIdNr, Programma, Gelukt)
            Else
                Call Verbinden(Connectie, Rst.StPPId, Rst.StPPWw, Rst.StIdNr, Programma, Gelukt)
            End If
            If Gelukt = False Then
                GoTo VolgSta
            End If
        End If

    '*** Aanmaak Tijdelijke Folder + bestanden voor FTP
        If Dir(ActiveTmpDir, vbDirectory) = "" Then
            MkDir ActiveTmpDir
        End If

    '*** Ophalen gegevens uit parameters
        StrSql = "SELECT * FROM TParms " _
               & "WHERE PaIdNr = 1 "

        Set Rst1 = Db.OpenRecordset(StrSql)

        If Rst1.EOF = False Then

        '*** Controle van uitzonderlijke gegevens

        '*** Directory CIS

            If IsNull(Rst.MoCisD) = False Then
                BDir = Rst.MoCisD
            Else
                BDir = Rst.PrBDir
            End If
        '*** Directory BOC
            If IsNull(Rst.MoBocD) = False Then
                LocV = Rst.MoBocD
                LocO = Rst.MoBocD
            Else
                LocV = Rst1.PaLocV
                LocO = Rst1.PaLocO
            End If
        '*** Vast gedeelte bestand
            If IsNull(Rst.MoAFix) = False And Rst.MoAFix <> "" Then
                Fixt = Rst.MoAFix
            Else
                If IsNull(Rst.PrFixt) = False Then
                    Fixt = Rst.PrFixt
                Else
                    Fixt = ""
                End If
            End If

        '*** Controle of kopie moet worden gemaakt
            If Rst1.PaCopy = True And IsNull(Rst1.PaCpyD) = False And Rst1.PaCpyD <> "" Then
                KopieDir = Rst1.PaCpyD
            Else
                KopieDir = ""
            End If

        '*** Aanmaak Ftp-commando's + programma's + Transfert bestand
            If Rst.PrFunc = "Put" Then
                LocV = LocV & Programma & "\"
                If Dir(LocV, vbDirectory) = "" Then
                    MkDir LocV
                End If
                Call RunFtp(ActiveTmpDir, Programma, Rst1.PaDelF, Rst.StFtpA, Rst.StFtpI, Rst.StFtpW, BDir, Rst.PrFunc, LocO, LocV & "Station-" & Format(Rst.StNumr, "00000") & "\", Fixt, Rst.PrRFil, 1, Rst.StIdNr, Rst.StPPId, Rst.StPPWw, Connectie, ActiveDir, Rst.StTokh, Rst1.PaPaus, Rst1.PaXpLi)
            End If
            If Rst.PrFunc = "Get" Then
                If Dir(LocO, vbDirectory) = "" Then
                    MkDir LocO
                End If
                If Dir(Rst1.PaTmpD, vbDirectory) = "" Then
                    MkDir Rst1.PaTmpD
                End If
                If Rst.PrManu = False Then
                    Call RunFtp(ActiveTmpDir, Programma, Rst1.PaDelF, Rst.StFtpA, Rst.StFtpI, Rst.StFtpW, BDir, Rst.PrFunc, LocO & Programma & "\", LocV, Fixt, Rst.PrRFil, 1, Rst.StIdNr, Rst.StPPId, Rst.StPPWw, Connectie, ActiveDir, Format(Rst.StTokh, "0000"), 0, Rst1.PaXpLi)
                    Call RunFtp(ActiveTmpDir, Programma, Rst1.PaDelF, Rst.StFtpA, Rst.StFtpI, Rst.StFtpW, BDir, Rst.PrFunc, LocO & Programma, LocV, Fixt, Rst.PrRFil, 2, Rst.StIdNr, Rst.StPPId, Rst.StPPWw, Connectie, ActiveDir, Format(Rst.StTokh, "0000"), 0, Rst1.PaXpLi)
                    Call RunFtp(ActiveTmpDir, Programma, Rst1.PaDelF, Rst.StFtpA, Rst.StFtpI, Rst.StFtpW, BDir, Rst.PrFunc, LocO & Programma & "\", LocV, Fixt, Rst.PrRFil, 3, Rst.StIdNr, Rst.StPPId, Rst.StPPWw, Connectie, ActiveDir, Format(Rst.StTokh, "0000"), 0, Rst1.PaXpLi)
                Else
                    Y0StA4 = Format(Rst.StNumr, "00000")
                    Call RunFtp(ActiveTmpDir, Programma, Rst1.PaDelF, Rst.StFtpA, Rst.StFtpI, Rst.StFtpW, BDir, Rst.PrFunc, LocO & Format(Rst.StNumr, "00000"), Rst1.PaTmpD, Fixt, Rst.PrRFil, 4, Rst.StIdNr, Rst.StPPId, Rst.StPPWw, Connectie, ActiveDir, Format(Rst.StTokh, "0000"), 0, Rst1.PaXpLi)
                End If
            End If

        End If

VolgSta:

    Rst.MoveNext

    Loop

    Boodschappen "L0105", Boodschap, Titel
    SysCmd acSysCmdSetStatus, Boodschap

End Function

 

[Guus2005]

misschien moet je even aangeven waar die inbelacties gedaan worden op basis van welke criteria een server wordt geselecteerd en waar in de code gegevens worden opgehaald.

Over je code: persoonlijk zou ik het opsplitsen in stukken (procedures/functies) met een eigen functie. Dan is het eenvoudiger te debuggen en makkelijker te lezen.

HTH