Recupere du contenu avec des champs en parametre

Commenter

Contenu du snippet

Ceci est une petite fonctionalité, que j'ai adapter suite à une demande que j'avais faite et dont je remercie Jack (Admin CS) pour sa réponse qui m'a bien aider.

Cette fonction est utiliser quand on a besoin d'avoir dans une table des textes fixes contenant en parametre des champs d'une autre table.
Example dans le post d'origine (http://www.vbfrance.com/infomsg.aspx?ID=1078046)

Source / Exemple : 


Sub RecupTexte()
'*** Définition des propriétés ***
Dim rst, rstTxt As DAO.Recordset
Dim pFields, pRow As Variant
Dim Idx, nCnt As Integer
Dim Texte as String

'Ouverture de la table/Query contenant les champs a introduire dans le texte
Set rst = CurrentDb.OpenRecordset("MyQuery", dbReadOnly) 
'Ouverture de la table contenant le texte a transformer
Set rstTxt = CurrentDb.OpenRecordset("tblTexte", dbReadOnly)
'Pour l'example je ne prend que le premier record, a vous de faire une boucle pour le reste
rst.MoveFirst
rstTxt.MoveFirst
' Compte le nombre de champs dans la table 1
nCnt = rst.Fields.Count - 1
' Redimensionne les Array
ReDim pFields(0 To nCnt)
ReDim pRow(0 To nCnt)
' Recupere les nooms des champs de la table 1
For Idx = 0 To nCnt
    pFields(Idx) = rst.Fields(Idx).Name
Next

'*** Mettre une boule si il faut parcourir la table ******

' Recupere les valeurs du record courrant
For Idx = 0 To nCnt
    pRow(Idx) = rst.Fields(Idx).Value
Next

'Recupere le texte transforme avec comme parametre: le champ contenant le texte a transfomer, la liste des champs a recuperer, le record pour les valeurs, et le sigle qui separe le nom des champs parametres
Texte = MakeTexte(rstDoc.Fields("tText"), pFields, pRow, "#")
Debug.Print Texte

rst.Close
rstDoc.Close
Set rst = Nothing
Set rstDoc = Nothing

End Sub

' **** Fonction pour le split du texte ****
Function MakeTexte(ByRef Texte, pFields, pRow As Variant, ByRef tCar As String) As String
Dim Result() As String
Dim nCnt, nCnt2, Idx, i, y As Integer
       
nCnt = UBound(pFields)
Result = Split(Texte, tCar)
nCnt2 = UBound(Result)

For i = 0 To nCnt2
    Idx = -1
    For y = 0 To nCnt
        If pFields(y) = Result(i) Then Idx = y
    Next
    If Idx > -1 Then Texte = Replace(Texte, tCar & Result(i) & tCar, pRow(Idx))
Next
    
MakeTexte = Texte

End Function

Conclusion :


Vous avez besoin de créer des mails automatiser, dont le texte est fixe, sauf qu'il vous faut les coordonées de contact et produit.
Si on a dans la table "tblTexte" un champ contenant du texte, style:

"Cher #TitrePers# #NomPers#, Nous vous informons que le produit contenant la référence:#NumProd# est disponible depuis le #DateLivr#....."

Dont "TitrePers", "NomPers", "NumProd", "DateLivr" sont des champs du Query "MyQuery".

Le résultat sera:

Texte = "Cher M. Xyz, Nous vous informons que le produit contenant la référence: 563587 est disponible depuis le 20/02/2008 ....."

Voila, j'espère que ca pourra aider quelqu'un ou pourrait du moin l'orienter.

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.