Extraction de mots dans une chaine de caractère

Bonsoir,
voici un exemple que j'ai teste en Excel (je connais mieux) mais que tu
pourras adapter:
la fonction Liste restitue les donnees dans la feuille, mais c'est la
fonction Extract qui extrait le tableau des infos
Sub Liste()
Dim ptrS As Range
Dim ptrT As Range
Dim aRes As Variant
Dim i As Long

Set ptrS = ActiveSheet.Cells(1, 1)
Set ptrT = ActiveSheet.Cells(5, 1)
Do While ptrS.Value <> ""
Call Extract(ptrS.Value, aRes)
For i = 1 To UBound(aRes, 1)
ptrT.Value = aRes(0)
ptrT.Offset(0, 1).Value = aRes(i)
Set ptrT = ptrT.Offset(1, 0)
Next i
Set ptrS = ptrS.Offset(1, 0)
Loop
End Sub

Sub Extract(ByRef str As String, aRes As Variant)
Dim sTxt As String
Dim sCle As String
Dim sMots As String
Dim i As Long
Dim j As Long
Dim aMots As Variant
'enleve le chemin
i = InStrRev(str, "", -1)
sTxt = Mid(str, i + 1)
'recupere la cle
i = InStrRev(sTxt, "-", -1, vbTextCompare)
sCle = Left(sTxt, i - 1)
'recupere les mots a analyser
sMots = Mid(sTxt, i + 1)
aMots = Split(sMots, " ")
ReDim aRes(0)
aRes(0) = sCle
j = 0
For i = 0 To UBound(aMots, 1)
If Len(aMots(i)) > 4 Then
j = j + 1
ReDim Preserve aRes(j)
aRes(j) = aMots(i)
End If
Next i
End Sub
Bon courage

"Gilbert" <nospam.gilnat37@free.fr> a écrit dans le message de
news:434bed2f$0$649$626a14ce@news.free.fr...

Bonjour,

Dans une table j'ai la liste de tous les fichiers de rplusieurs
répertoires.

exemple :
Table1
c:Dossier1Sousdossier1DER-015-02-Gestion des Anomalies
c:Dossier1Sousdossier2HER-001-01-Gestion des Arrivages
c:Dossier2Sousdossier1JIS-005-05-Déclaration des Anomalies
......

Je souhaiterais faire une table de mots clés composés des mots important
(>à

4 caractères par exemple)
entrant dans le nom du fichier afin de faire une recherche de ces
fichiers.

Table2
Champs1 Champs2
DER-015-02 Anomalies
DER-015-02 Gestion
HER-001-01 Gestion
HER-001-01 Arrvages
.......


Pourriez-vous m'indiquer une méthode...
(découpage d'une chaine de caractère...ma recherche sur le forum de
discussion n'a rien donné)

Je souhaiterais pouvoir mettre à jour cette table de mots clés à chaque
nouvelle entrée d'un fichier.
Si quelqu'un pouvais me donner quelques références pour me mettre sur la
voie.

Merci

Gilbert

Merci,
J'ai visiblement un bon point de départ pour travailler
Gilbert

"TiMike45" <TiMike45@free.fr> a écrit dans le message de news:
434d5b15$0$12561$626a14ce@news.free.fr...

Bonsoir,
voici un exemple que j'ai teste en Excel (je connais mieux) mais que tu
pourras adapter:
la fonction Liste restitue les donnees dans la feuille, mais c'est la
fonction Extract qui extrait le tableau des infos
Sub Liste()
Dim ptrS As Range
Dim ptrT As Range
Dim aRes As Variant
Dim i As Long

Set ptrS = ActiveSheet.Cells(1, 1)
Set ptrT = ActiveSheet.Cells(5, 1)
Do While ptrS.Value <> ""
Call Extract(ptrS.Value, aRes)
For i = 1 To UBound(aRes, 1)
ptrT.Value = aRes(0)
ptrT.Offset(0, 1).Value = aRes(i)
Set ptrT = ptrT.Offset(1, 0)
Next i
Set ptrS = ptrS.Offset(1, 0)
Loop
End Sub

Sub Extract(ByRef str As String, aRes As Variant)
Dim sTxt As String
Dim sCle As String
Dim sMots As String
Dim i As Long
Dim j As Long
Dim aMots As Variant
'enleve le chemin
i = InStrRev(str, "", -1)
sTxt = Mid(str, i + 1)
'recupere la cle
i = InStrRev(sTxt, "-", -1, vbTextCompare)
sCle = Left(sTxt, i - 1)
'recupere les mots a analyser
sMots = Mid(sTxt, i + 1)
aMots = Split(sMots, " ")
ReDim aRes(0)
aRes(0) = sCle
j = 0
For i = 0 To UBound(aMots, 1)
If Len(aMots(i)) > 4 Then
j = j + 1
ReDim Preserve aRes(j)
aRes(j) = aMots(i)
End If
Next i
End Sub
Bon courage

"Gilbert" <nospam.gilnat37@free.fr> a écrit dans le message de
news:434bed2f$0$649$626a14ce@news.free.fr...

Bonjour,

Dans une table j'ai la liste de tous les fichiers de rplusieurs
répertoires.

exemple :
Table1
c:Dossier1Sousdossier1DER-015-02-Gestion des Anomalies
c:Dossier1Sousdossier2HER-001-01-Gestion des Arrivages
c:Dossier2Sousdossier1JIS-005-05-Déclaration des Anomalies
......

Je souhaiterais faire une table de mots clés composés des mots important
(>à

4 caractères par exemple)
entrant dans le nom du fichier afin de faire une recherche de ces
fichiers.

Table2
Champs1 Champs2
DER-015-02 Anomalies
DER-015-02 Gestion
HER-001-01 Gestion
HER-001-01 Arrvages
.......


Pourriez-vous m'indiquer une méthode...
(découpage d'une chaine de caractère...ma recherche sur le forum de
discussion n'a rien donné)

Je souhaiterais pouvoir mettre à jour cette table de mots clés à chaque
nouvelle entrée d'un fichier.
Si quelqu'un pouvais me donner quelques références pour me mettre sur la
voie.

Merci

Gilbert

Salut

si tu considère que table2.champs1 est toujours de la forme ABC-000-00 alors c'est assez simple

Const vc_nb_lettres_min As Byte = 4

Private Sub s_mots_cles()

Dim v_chemin As String, v_cle As String, v_mots As Variant, v_fichier As String
Dim v_rst As Recordset, m As Byte, i As Byte

Set v_rst = CurrentDb.OpenRecordSet("SELECT * FROM Table1;", dbOpenSnapShot)

With v_rst
If Not .EOF Then
.MoveFirst
Do While Not .EOF
v_chemin = Nz(!Chemin)
v_fichier = Mid(v_chemin, InStrRev(v_chemin,"") + 1)
v_cle = Left(v_fichier, 10)
v_fichier = Mid(v_fichier, 12)
v_mots = f_analyse_mots(v_fichier)
DoCmd.SetWarnings False
m = Ubound(v_mots)
For i = 0 to m
v_sql = "INSERT INTO Table2 (Champ1, Champ2) VALUES ('" & v_cle & "', '" & v_mots(i) & "');"
DoCmd.RunSQL v_sql
Next
DoCmd.SetWarnings True
.MoveNext
Loop
End If
End With
End Sub

Private Function f_analyse_mots(ByVal vp_chaine As String) As Variant
Dim v_mots As Variant, i As Byte, j As Byte, m As Byte
v_mots = Split(vp_chaine, " ")
m = Ubound(v_mots)
For i = 0 to m
If Len(v_mots(i)) < vc_nb_lettres_min Then
For j = i + 1 to m
v_mots(j - 1) = v_mots(j)
Next
Redim Preserve v_mots(m - 1)
m = Ubound(v_mots)
End If
Next
f_analyse_mots = v_mots
End Sub


' -------------------
J'ai pas testé, mais cela devrait être qq chose comme ça

Ouala
Bye
Buddy