FONCTION REPLACE POUR ACCESS 97 AUSSI PERFORMANTE QUE REPLACE DE VB

'Ayant eu à convertir un appli access 2000
'en access 97 je me suis aperçu que la fonction
'replace dans access 97 n'était pas prise en charge
'-----------
'voici le code qui test ma fonction
'-------------------


'@+, VIC

Option Explicit
'--------------
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub btnOpen_Click()
    Dim sTmp As String, sText As String
    With Cdlg
        .Filter = "Texte (*.txt)|*.txt"
        .InitDir = App.Path
        .ShowOpen
        If .FileName <> "" Then
            Open .FileName For Input As #1
            Do While Not EOF(1)
                Line Input #1, sTmp
                sText = sText & sTmp
            Loop
            txtSource.Text = sText
            Close #1
            txtResult = ""
        End If
    End With
    
End Sub

Private Sub btnVbReplace_Click()
    Dim lngSTime As Long, lngETime As Long
    If Len(txtSource) = 0 Then
        MsgBox "choisir un fichier", vbCritical, "Pas de fichier sélectionné"
        Exit Sub
    End If
    ' ----
    lngSTime = GetTickCount()
    txtResult = Replace(txtSource, txtRemplaceSA, txtParSA)
    lngETime = GetTickCount()
    lblVbResult = lngETime - lngSTime
End Sub

Private Sub btnVicoReplace_Click()
    Dim lngSTime As Long, lngETime As Long
    If Len(txtSource) = 0 Then
        MsgBox "choisir un fichier", vbCritical, "Pas de fichier sélectionné"
        Exit Sub
    End If
    ' ----
    lngSTime = GetTickCount()
    txtResult = ReplaceItem(txtSource, txtRemplaceSA, txtParSA)
    lngETime = GetTickCount()
    lblVicoResult = lngETime - lngSTime
End Sub

Private Function ReplaceItem(ByVal sItem As String, _
                            ByVal sFindString As String, _
                            ByVal sReplaceString As String) As String
                            
    ' ----
    If InStr(sItem, sFindString) = 0 Then
        ReplaceItem = sItem: Exit Function
    End If
    ' ----
    
    Dim iPos As Long, sTmp As String
    iPos = 1
    
    Do
        iPos = InStr(iPos, sItem, sFindString)
        If iPos > 0 Then
            Mid(sItem, iPos, 1) = sReplaceString
        Else
            Exit Do
        End If
    Loop
    ' ----
    ReplaceItem = sItem
End Function

Télécharger le zip