1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
| '===============================================================================
Public Function VarChaînePourSQL(ByVal Chaîne As Variant) As Variant
'CRÉATION : 06 février 1999 © AUTINOR - Hervé Mary
'MODIFICATIONS : 23 février 2002 - Hervé Mary
' * CORRECTION DE BUG :
' La technique, développée dans le "Guide du développeur"
' Sybex par Paul Litwin, et qui consistait à encadrer la
' chaîne d'apostrophes et à doubler les apostrophes à l'in-
' térieur de la chaîne NE FONCTIONNE PAS. Par exemple, le
' moteur de base de données JET ne trouve pas la chaîne
' "GUIDE D'EMPLOI", car il cherche en réalité la chaîne
' "GUIDE D''EMPLOI".
' La fonction a été modifiée pour donner satisfaction même
' lorsque la chaîne inclue simultanément des guillemets et
' des apostrophes.
'DESCRIPTION :
' Cette fonction reçoit une chaîne de caractères et retourne cette chaîne
'après l'avoir formatée de manière à ce qu'elle puisse servir de critère à une
'requête SQL utilisée par le moteur de base de donnée JET.
'Elle retourne Null si la variable reçu était Null ou Empty.
'Par exemple, s'il faut chercher les enregistrement dont le champ "MotsClé"
'contient un mot contenu dans la variable "MotCherché", la requête correspon-
'dante sera construite à partir des instruction :
' FindFirst("MotsClé=" & VarChaînePourSQL(MotCherché)
'
'Pour ce faire :
'* Si la chaîne comporte des apostrophes (') mais pas de guillemets ("), la
' fonction encadre la chaîne de guillemets (") ;
'* Si la chaîne comporte des guillemets (") mais pas d'apostrophes ('), la
' fonction encadre la chaîne d'apostrophes (') ;
'* Si la chaîne comporte à la fois des apostrophes et des guillemets, la fonction
' la scinde en 2 chaînes qu'elle sépare du caractère de concaténation (&) et
' s'appelle de manière récursive pour chacune de ces chaînes.
'
'Exemples :
' si la fonction reçoit : Le roi d'Afrique
' elle retourne : "Le roi d'Afrique"
' si la fonction reçoit : '"roi" d'Afrique
' elle retourne : "'" & '"roi d" & "'Afrique"
' si la fonction reçoit : Le "roi" du monde
' elle retourne : 'Le "roi" du monde'
' si la fonction reçoit : Le "roi" d'Afrique
' elle retourne : 'Le "roi" d' & "'Afrique"
' si la fonction reçoit : Le "roi" d'afrique et le "prince" d'angleterre
' elle retourne : 'Le "roi" d' & "'Afrique et le" & '"prince" d' & "'angleterre"
'
'INFORMATIONS REÇUES :
' Chaîne : chaîne à traiter
'
'CONDITIONS ET EXCEPTIONS :
' La fonction s'appelle de manière RECURSIVE
'-------------------------------------------------------------------------------
Dim Chaîne1 As String
Dim Chaîne2 As String
Dim PosApos As Long
Dim PosGuill As Long
Dim Scission As Long
VarChaînePourSQL = Null 'Présumer une erreur d'argument
If IsEmpty(Chaîne) Or IsNull(Chaîne) Then Exit Function
'Vérifier que le variant est vraiment un chaîne de caractères
On Error GoTo Err_VarChaînePourSQL:
Chaîne = CStr(Chaîne)
VarChaînePourSQL = "" 'Présumer une chaîne vide
If Chaîne = "" Then Exit Function
PosApos = InStr(1, Chaîne, "'", vbBinaryCompare)
PosGuill = InStr(1, Chaîne, """", vbBinaryCompare)
If PosApos > 0 And _
PosGuill > 0 Then
'Apostrophe et guillements
'Scinder la chaîne avant le second caratère particulier
If PosApos > PosGuill Then Scission = PosApos Else Scission = PosGuill
'Si la scission doit avoir lieu avant le premier caractère de la chaîne
'l'appel récursif n'aura pas de fin et provoquera un débordement de pile
'Normalement ce cas ne peut pas se produire, mais on ne sait jamais.
If Scission = 1 Then GoTo Err_VarChaînePourSQL
Chaîne1 = Mid(Chaîne, 1, Scission - 1)
Chaîne2 = Mid(Chaîne, Scission)
VarChaînePourSQL = VarChaînePourSQL(Chaîne1) & _
" & " & _
VarChaînePourSQL(Chaîne2)
ElseIf PosApos > 0 Then
'Apostrophe uniquement
VarChaînePourSQL = """" & Chaîne & """"
Else
'Guillemets uniquement
VarChaînePourSQL = "'" & Chaîne & "'"
End If
Err_VarChaînePourSQL:
End Function 'VarChaînePourSQL |
Partager