Fonction replace pour access 97 aussi performante que replace de vb

Télécharger le projet
Commenter

Description

Ayant eu à convertir une BD Access 2000 en access 97 je me suis rendu compte que la fonction replace n'existait pas... d'ou ce source !

@+

Source / Exemple : 


'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

Conclusion :


Voir le zip
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (VicoLaChips2)