Discussion :

[jpvba65]

Bonjour

A l'aide de l'enrgistreur de macro j'essaye de réaliser (en partie) ce qui suis:
Je voudrais récupérer une partie du texte (suivant des mots clé) dans plusieurs (nombreux) fichiers RTF (sans les ouvrir) situés dans un même dossier.
Les textes récupérés viendraient remplir un tableau excel qui servirait de récapitulatif.
Celà part très mal car l'enregistreur de macro ne donne aucun code montrant l'action d'aller chercher le chemin du dossier.
Est-ce que celà est impossible avec l'enregistreur?
Sinon y a t'il un code qui permet ça.

Je précise que je suis sous excel 2010.

Merci par avance et bonne soirée à toutes et tous.

[jpvba65]

Bonjour

Sur le forum j'ai trouvé le code suivant.
Il semble être une bonne piste pour moi mais j'aboutit à un message d'erreur
au niveau de "Rc.Open Source:=myreq, ActiveConnection:=cn"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim Chemin As String, Fichier As String
Dim lig As Integer
 
Sub BoucleFichiers()
 
    'vérifie si il y a une donnée en A1 si non
    If Sheets("Feuil1").Range("A1") = "" Then
        lig = 1
    Else 'si oui donne à lig la valeur de la dernière ligne utilisée + 2
        lig = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row + 2
    End If
 
    'Définit le répertoire contenant les fichiers
    Chemin = "C:\Temp 2\Résultats xls\"
 
    'Boucle sur tous les fichiers RTF du répertoire.
    Fichier = Dir(Chemin & "*.RTF")
    'Utilisez la syntaxe suivante pour boucler sur tous les types de fichiers:
    'Fichier = Dir(Chemin & "*.*")
 
    'parcours chaque fichier du répertoire
    Do While Len(Fichier) > 0
 
        'appelle la macro pour copier les données
        Call importFichierTexte_ADO
 
        lig = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row + 2
        Fichier = Dir()
    Loop
End Sub
 
Sub importFichierTexte_ADO()
    Dim Rc As ADODB.Recordset
    Dim cn As String
    Dim i As Long
 
Rem**************************************************************
    'Nécessite d'activer la référence
        'Microsoft ActiveX Data Objects 2.x Library
Rem**************************************************************
 
    cn = "Driver={Microsoft Text Driver (*.txt; *.csv; *.RTF)};" & _
        "Dbq=" & Chemin & ";Extensions=asc,csv,tab,txt,RTF"
 
 
    'requête de sélection des données
    myreq = "SELECT * FROM " & Fichier
 
    'connection au fichier RTF
    Set Rc = New ADODB.Recordset
    Rc.Open Source:=myreq, ActiveConnection:=cn
 
    'copie des données
    If Not Rc.EOF Then
        For i = 0 To Rc.Fields.Count - 1 'recuperation entetes
           Sheets("Feuil1").Cells(lig, 1) = Rc.Fields(i).Name
        Next
           Sheets("Feuil1").Range("A" & lig + 1).CopyFromRecordset Rc
    End If
 
    Rc.Close
End Sub

Je précise que j'ai activé ActiveX dans les options.

Je continue à fouiller

[Docmarti]

Bonjour.

Si tu as dans les contrôles supplémentaires Microsoft Rich TextBox Control,
tu peux lire les fichiers RTF ainsi:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
With RichTextBox1
        .Enabled = True
        .LoadFile "c:\test2\document.rtf"
 End With

Cordialement

Docmarti

[jpvba65]

Docmarti

Je te remercie pour ta réponse.
Je n'ai pas "Microsoft Rich TextBox Control" dans mes contrôles.
Par contre à l'aide d'une autre macro j'ai pu ouvrir au moins un de mes fichiers ".RTF" et le résultat est la présence d'énormément de caractères "parasites" en plus du texte qui m’intéresse.
Je pense qu'avant d'aller plus loin je vais tenter d'avoir mes fichiers aux format texte.
Pour ceux qui pourraient être intéressés je joint le deuxième code (également trouvé sur le forum).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub toto()
 
    Dim Classeur As Workbook
    Dim tablo() As String
    Dim Chemin As String
    Dim Fichier As String
    Dim I As Integer
    Dim Valeur As String
    Dim Cel As Range
 
    Chemin = "C:\Temp 2\Résultats xls\"
    Fichier = Dir(Chemin & "*.RTF")
    Do While Fichier <> ""
        I = I + 1
        ReDim Preserve tablo(1 To I)
        tablo(I) = Fichier
        Fichier = Dir
    Loop
    For I = 1 To UBound(tablo)
        'ouverture du classeur avec utilisation d'une variable
        Set Classeur = Workbooks.Open(Chemin & tablo(I))
        'ici le code de récupération des valeurs...
        Valeur = Classeur.Worksheets("Feuil1").Range("A1")
        'inscrit la valeur en colonne A à la suite des autres
        With ThisWorkbook.Worksheets("Feuil1")
            .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = Valeur 'sur colonne A
        End With
        'fermeture du classeur avant ouverture du suivant
        Classeur.Close
 
    Next I
 
End Sub

Encore une fois merci Docmarti

Bonne soirée

[Docmarti]

Je n'ai pas "Microsoft Rich TextBox Control" dans mes contrôles.

Il semble que tu peux le trouver ici : RichTxt32.ocx

http://www.ocxdump.com/ocx-files/R_1.html


Docmarti

[jpvba65]

Bonjour

Docmarti j'ai téléchargé le fichier que tu m'a indiqué mais j'avoue que je ne sais pas quoi en faire.
Par contre je m'éloigne du fichier RTF car je vais pouvoir avoir l'équivalent des informations qu'il contenait directement dans un fichier xls.
Ma macro a évoluée en ce sens mais pour l'instant je ne la diffuse pas car elle n'est pas totalement fonctionelle.
Le titre de ma discussion est toujours valable sauf que le format n'est plus RTF mais XLS.

Merci et bonne soirée

[Docmarti]

jpvba65

Dézipper. Copier RICHTX32.OCX dans le répertoire C:\Windows\System32

Puis taper dans la fenêtre Exécuter :

Regsvr32 RICHTX32.OCX

Voir instruction sur cette page si nécessaire.
http://assiste.com.free.fr/p/comment...er_dll_ocx.php


Cordialement
Docmarti

[jpvba65]

Bonjour

Docmarti j'ai fait comme indiqué mais pas de changement.
Avec la première macro de mon post j'ai toujours le même message d'erreur au même endroit. J'ai essayé
avec le format xls et c'est pareil.
Mais c'est pas grave, comme indiqué précédemment j'ai migré vers le format XLS
avec un troisième macro plus prometteuse et qui cerise sur le gâteau me permet de sélectionner le dossier source depuis une fenêtre windows.
Je te fait un grand merci pour le suivi que tu accordes à mon problème.

Bonne soirée

[AlainTech]

Bonjour,

Ta connexion n'est pas ouverte.
De plus, cn est typé String.
Ca ne peut donc pas fonctionner.
Il te faut, au moins, une variable typée ADODB.Connection.
cn, dans ton cas, n'est que la Connection String.

[jpvba65]

Bonjour

Merci AlainTech pour ta réponse.
Etant grand débutant en macro je t'avoue que tes explications sont pour moi du chinois.
Comme indiqué précédemment à Docmarti j'ai basculé sur une version xls des fichiers qui reprend les éléments que je recherchais dans les fichiers RTF (même si je ne ferme pas complètement la porte au format RTF).
Bien évidement j'ai aussi des soucis avec une macro qui fait mon tri et dont voici le code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Sub ImporterDates()
Dim objShell As Object
Dim objFolder As Object
Dim Chemin As String
Dim fichier As String
 
 
    Set objShell = CreateObject("Shell.Application")
'Ouvre une fenêtre Window pour sélectionner le dossier
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
If objFolder Is Nothing Then
 'message
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
 'sinon
Else
 'Chemin = répertoire choisi
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'Choix du 1er fichier
    fichier = Dir(Chemin & "*.xls")
'on boucle sur tous les fichiers excel du répertoire choisi
    Do While Len(fichier) > 0
      If fichier <> ThisWorkbook.Name Then
            With Sheets("Feuil1")
'Inscrit le nom des fichiers en colonne A
                Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = fichier
'Inscrit le contenu de la cellule A3 en B
                Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & "[" & fichier & "]Feuil1'!A3"
            End With
        End If
        fichier = Dir()
    Loop
End If
End Sub

Mon problème est que j'arrive à copier le nom de chaque fichiers xls les uns en dessous des autres en colonne A mais en colonne B le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & "[" & fichier & "]Feuil1'!A3"

qui est censé récupérer le contenu des cellules A3 de mes fichiers xls pour les
placer en colonne B à côté de chaque nom de fichier correspondant fonctionne de manière incomplète.
En effet après avoir indiqué le chemin du dossier, le nom du premier fichier est placé en cellule A2, le contenu de la cellule A3 du fichier initial est effectivement placé en B2.
Ensuite à partir du deuxième fichier à trier ça se gâte, une fenêtre windows me demande d'indiquer le fichier, si je l'indique la cellule A3 est copiée, si je clique sur annuler la fenêtre se ferme mais une autre se ré ouvre de suite.
Par contre le nom du fichier c'est lui correctement placé à la suite du précédent.
Tout celà continue jusqu'à l'avant dernier fichier à trier car le dernier lui est correctement traité (comme le premier). Ci-joint le fichier que j'obtient quand je clique à chaque fois sur annuler.

Merci pour toute aide

[jpvba65]

Bonjour

Une remarque
Lorsque je vais dans le dossier (sans passer par la macro) contenant les classeurs à traiter et que j'ouvre et referme chaque classeur et qu'ensuite
je lance ma macro, tout fonctionne pour chaque classeurs (je récupère le nom du fichier et la cellule A3 de chaque) sans avoir à redonner systématiquement le chemin des classeurs.
Je fais mes essais avec seulement 6 fichiers heureusement, je me vois mal appliquer cette méthode sur 1000 classeurs.
Si quelqu'un a une idée celà m'aiderait bien.

Bonne soirée

[AlainTech]

Bonjour,

Essaie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "='[" & chemin & fichier & "]Feuil1'!A3"

Non testé... Je n'ai jamais utilisé cette technique.

[jpvba65]

Bonjour

Alain Tech merci pour ta réponse.
Après essai celà ne marche pas (#REF inscrit dans toutes les cellules correspondantes de la colonne B).
J'ai eu une réponse sur un autre forum qui est très très proche de la tienne,
la voici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]Feuil1'!A3"

Et la tout rentre dans l'ordre, la macro fonctionne.

Je vais classer la discussion comme résolu car le but était quand même de pouvoir récupérer le contenu de documents fermés.
Pour ce qui est du format RTF je continuerai a essayer des solutions dans mon coin.

Encore merci Alain Tech pour ton suivi.