VBA Extraction données word avec fonction input vers Excel

Le 03/05/2019 à 11:08

Bonjour à vous,

je rencontre un obstacle que je peine à contourner.

Afin de récolter des informations d'une page word dans un array, j'utilise la fonction Open de vba Open strFileName For Input As #fileIndex puis je boucle sur chaque ligne avec un Do While Not EOF(fileIndex). (Je place le code ci dessous).

Cependant, alors que le fichier de départ contient beaucoup de lignes, ainsi qu'une image, le débugger me fait ressortir une seule ligne, comme si EOF avait été trouvé: le "do" s'arrêtant effectivement après sa première boucle. Voici la ligne concernée: PK!ZØÍÐÈ [Content_Types].xml ¢( ÄVKkÜ0¾òŒ®ÁÖ&…RÊzsÈ㘺¥

Quelqu'un saurait il comment je peux boucler en contournant ce EOF qui devrait continuer jusqu'à la fin du document? Ou constatez vous une erreur d'approche de ma part? Voici le code:

Sub wordDocExtraction(ByVal strFileName As String)

Application.ScreenUpdating = False
On Error GoTo extractorErrorHandler

'Définition des variables
Dim fileIndex As Integer
Dim ContenuLigne As String

'Assignation et ouverture d'un fichier à ouvrir
fileIndex = FreeFile()                       '(Fonction vba: donne un index disponible de fichier)
Open strFileName For Input As #fileIndex     'ouvre le fichier

'Parcour des lignes du fichier et insertion du contenu dans la variable contenu ligne
Do While Not EOF(fileIndex) '
    Input #fileIndex, ContenuLigne     ' lecture du fichier ligne par ligne: la variable "ContenuLigne" contient le contenu de la ligne active
    Debug.Print ContenuLigne
Loop

'Fermeture du fichier et réactivation du rafraichissement d'écran
Close #fileIndex
Application.ScreenUpdating = True
Stop
Exit Sub

extractorErrorHandler:
MsgBox "Le programme a rencontré une erreur."
Exit Sub
End If

End Sub

J'ai mis un exemple de document word en pj.

39test-demdande.docx (47.79 Ko)
Le 03/05/2019 à 12:51
Le 03/05/2019 à 12:57

Bonjour,

merci de votre aide.

Oui la macro se réalise sans erreur, seulement lorsqu’on assigne le fichier qu’en j’ai placé en pièce jointe étonnamment on ne recupere pas les informations présentes dans le fichier (nom, prénom, etc).

Je me demande si de votre côté également la boucle fait un seul tour...

Si vous avez-vous une petite idée je suis entièrement preneur.

Le 03/05/2019 à 12:58

re,

à tester,

'ajouter la référence : Microsoft Scripting Runtime.
Sub LireFichierTexte()
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.file
Dim oTxt As Scripting.TextStream
Dim i As Integer

'à adapter
fileName = "C:\Users\isabelle\Documents\Excel_Pratique_forum\Theophile69-TEST DEMDANDE.docx"

Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile(fileName)
Set oTxt = oFl.OpenAsTextStream(ForReading)
'Lire
While Not oTxt.AtEndOfStream
i = i + 1
  Range("A" & i) = oTxt.ReadLine
Wend
End Sub
Le 03/05/2019 à 15:57

Bravo i20100, c'est exactement ce que je cherchais.

Cependant je constate que je récupère uniquement des caractères codés. Sais tu de quoi il en retourne par hasard?

Je vais aller voir du côté de l'encodage Word cependant j'avoue naviguer à vue.

Merci encore pour cette étape décisive.

Le 03/05/2019 à 18:35

re,

J’ai essayé les 3 méthodes, et aucun résultat

TristateUseDefault -2 Ouvre le fichier en utilisant la valeur par défaut du système.

TristateTrue -1 Ouvre le fichier en tant que Unicode.

TristateFalse 0 Ouvre le fichier en tant qu'ASCII

Set oTxt = oFl.OpenAsTextStream(ForReading, TristateUseDefault)
Le 03/05/2019 à 18:59

re,

en enregistrant le fichier en format txt il n'y a pas de problème à le lire.

Sub SaveAs_txt()
Application.DisplayAlerts = False
nom = ActiveDocument.FullName
nom = Left(nom, Len(nom) - 4) & "txt"
ActiveDocument.SaveAs FileName:=nom, FileFormat:=wdFormatText
Application.DisplayAlerts = True
End Sub
Le 03/05/2019 à 19:13

Purée! Tu gères bien les stream!!!

J’essaie dès lundi. Merci beaucoup.

Le 04/05/2019 à 15:44

re,

à tester,

'ajouter les références :
'-   Microsoft Scripting Runtime.
'-   Microsoft Word xx.x Object Library

Sub LireFichierTexte()
Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.file
Dim oTxt As Scripting.TextStream
Dim MonDocument As Document
Dim i As Integer
Application.DisplayAlerts = False

'à adapter
Filename = "C:\Users\isabelle\Documents\Excel_Pratique_forum\Theophile69-TEST DEMDANDE.docx"
NewFilename = Split(Filename, ".")(0) & ".txt"
Set MonDocument = Documents.Open(Filename)
MonDocument.SaveAs Filename:=NewFilename, FileFormat:=wdFormatText
MonDocument.Close

Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile(NewFilename)
Set oTxt = oFl.OpenAsTextStream(ForReading)
'Lire
While Not oTxt.AtEndOfStream
i = i + 1
  Range("A" & i) = oTxt.ReadLine
Wend
Application.DisplayAlerts = True
End Sub
Le 07/05/2019 à 08:30

Bonjour i20100,

le debuger m'anonce "Erreur d'éxécution 429: un composant active X ne peut pas créer d'objet". Il bloque alors sur la ligne "Set monDocument = Documents.Open(strFileName).

As tu une idée de l'erreur, je peine à comprendre. Voici si besoin le code que j'ai adapté.

Attentif à ton retour si possible. Merci.

Sub testWordDOc(ByVal strFileName As String)

Dim oFSO As Scripting.FileSystemObject
Dim oFl As Scripting.File
Dim oTxt As Scripting.TextStream
Dim MonDocument As Word.Document
Dim i As Integer
Dim recupDonnnees(1000) As String
Dim NewFilename As String

Application.DisplayAlerts = False

'Changement de l'extension en ".txt"
NewFilename = Split(strFileName, ".")(0) & ".txt"
Set MonDocument = Documents.Open(strFileName)
MonDocument.SaveAs Filename:=NewFilename, FileFormat:=wdFormatText
MonDocument.Close

Set oFSO = New Scripting.FileSystemObject
Set oFl = oFSO.GetFile(NewFilename)
Set oTxt = oFl.OpenAsTextStream(ForReading)

'Obtention des données
While Not oTxt.AtEndOfStream
i = i + 1
  recupDonnnees(i) = oTxt.ReadLine
  Debug.Print recupDonnnees(i)
Wend

Application.DisplayAlerts = True

End Sub
Le 07/05/2019 à 11:36

re,

as-tu ajouté les 2 références ?

  • Microsoft Scripting Runtime.
  • Microsoft Word xx.x Object Library
Le 07/05/2019 à 15:18

Bonjour,

C'est bon j'ai trouvé.

Bêta que je suis, la fonction split venait sectionner le string sur un autre point que celui de l'extension. Donc le chemin devenait invalide.

Tout fonctionne parfaitement.

Une fois de plus je te remercie sincèrement pour ton aide!

Le 08/05/2019 à 14:17

Merci pour ce retour, au plaisir!

si le problème est résolu, Merci de clôturer le fil, par un clic sur le bouton (indiquer par la flèche verte)

resolu

@+

Le 10/05/2019 à 11:42

Bonjour i20100,

peux tu m'éclairer sur quelque chose.

D'un coup ma macro ne fonctionne plus. J'avoue que je me perds et je voulais savoir si tu voyais quelque chose dans le code qui ne fonctionnerait plus??? Je me retrouve avec la même erreur "un objet activeX ne peut pas créer d'objet". Et pourtant le chemin du fichier est bon cette fois ci.

Seconde question si tu as le temps: pourquoi l'objet "documents" et sa méthode "open" ne passe passe par la déclaration d'un objet word.application en début de macro? Dans mon debbuger, après la déclaration Dim MonDocument As Document l'inspecteur de variables dit que MonDocument est vide (c'est pour ça que j'ai tenté de préciser le type en word.document).

Je suis perdu.

Si tu as une lumière?

Merci.

[code]Sub testWordDOc()

Dim oFSO As Scripting.FileSystemObject

Dim oFl As Scripting.File

Dim oTxt As Scripting.TextStream

Dim MonDocument As Word.Document

Dim i As Integer

Dim recupDonnnees(1000) As String

Dim newFileName As String

Application.DisplayAlerts = False

strFileName = "C:\Users\confidentiel\Desktop\Demandes Individuelles\20190510_103105Demande_intervention.doc" ' A remplir

'Changement de l'extension en ".txt"

newFileName = Split(strFileName, ".")(0) & ".txt"

Set MonDocument = Documents.Open(strFileName)

MonDocument.SaveAs Filename:=newPathName, FileFormat:=wdFormatText

MonDocument.Close

Set oFSO = New Scripting.FileSystemObject

Set oFl = oFSO.GetFile(newFileName)

Set oTxt = oFl.OpenAsTextStream(ForReading)

'Obtention des données

While Not oTxt.AtEndOfStream

i = i + 1

recupDonnnees(i) = oTxt.ReadLine

Debug.Print recupDonnnees(i)

Wend

Application.DisplayAlerts = True

End Sub

/code]

Le 10/05/2019 à 14:02

re,

c'est quoi la variable newPathName ?

Le 10/05/2019 à 14:43

Bonjour i20100,

désolé mon précédent message était incomplet.

Voici la fonction que j'exploite dorénavant. J'avais donc omis la ligne pour newPathName

Ecoute c'est étonnant. Ça refonctionne d'un coup alors que ma seule manip fut d'avoir lancé précédemment une macro instanciant un objet word Set appWord = createobject("word.application")

Comme si l'objet Word restait dans le fond et permettait à présent à la macro de fonctionner.

Ne trouves-tu pas étonnant que dans ton code tu puisses assigner et ouvrir un objet document sans instancier Word? Ne l'aurais tu pas fais précédemment sur ta machine?

Qu'en penses tu?

J'avoue être assez décontenancé.

Merci.

Function wordExtensionModifyer(ByVal tempFolderPath As String, ByVal attachmentName As String, ByRef strFileName As String)

Dim MonDocument As Word.Document
Dim NewFilename, newPathName As String

'Reconstruction du nom de fichier en ".txt" et du nouveau chemin d'accès
If InStr(attachmentName, ".docx") <> 0 Then
NewFilename = Left(attachmentName, Len(attachmentName) - 5) & ".txt"
Else
NewFilename = Split(attachmentName, ".")(0) & ".txt"
End If
newPathName = tempFolderPath & "\" & NewFilename

'Ouverture et resauvegarde du document
Set MonDocument = documents.Open(strFileName)
MonDocument.SaveAs Filename:=newPathName, FileFormat:=wdFormatText
MonDocument.Close

'Vidage mémoire
'Set oWord = Nothing
Set MonDocument = Nothing

'Retour du chemin fichier
strFileName = newPathName
End Function
Le 10/05/2019 à 14:56

re,

je ne vois pas le rapport entre la macro testWordDOc et la function wordExtensionModifyer

puisque la function n'est pas utiliser dans la macro.

Rechercher des sujets similaires à "vba extraction donnees word fonction input"