Autres Macro VBA qui coince...sous Word

[Rénato]

Bonjour le forum

J'ai fouillé sur différents forums, sans trouver mon bonheur, alors je me lance ici sur un souci VBA mais sur du Word. (Veuillez m'excuser, si je n'ai pas tout à fait visé la bonne classification)

J'aurais le besoin suivant : j'ai des documents avec des extensions "exotiques" répartis dans de nombreux répertoires et je souhaiterais que chacun d'entre eux soit intégré dans un document word (Insertion\objet\créé à partir du fichier\affiché sous forme d’icone) et porterait le nom du fichier.

Exemple : j'ai les fichiers toto.xxxx, titi.yyyy et tutu.zzzz dans le répertoire MACHIN. Une fois que ma macro (qui se trouve dans un document Word et également dans le répertoire MACHIN) aura tourné, je vais trouver dans mon répertoire MACHIN un fichier toto.docx, un fichier titi.docx et un fichier tutu.docx.
Et si j'ouvre toto.docx, dans le document word, j'y trouve toto.xxxx, si j'ouvre titi.docx, dans le document word, j'y trouve titi.yyyy etc....

Je me suis essayé avec le code ci-dessous, mais ce que je cherche c'est que la macro me traite tous les fichiers les uns après les autres dans le répertoire.

Sub Encapsuler()
Dim chemin As String

chemin = ActiveDocument.Path 'la macro est exécutée dans le répertoire où se trouvent les fichiers à traiter
MyName = Dir("*.*")
intPos = InStrRev(MyName, ".") 'objectif retirer l'extension dans le nom plus bas
While MyName <> "" 'boucle pour traiter tous les fichiers contenus dans le répertoire
Documents.Add 'ouverture d'un fichier word
With Selection 'c'est surtout dans les 4 lignes suivantes ou je souhaite que la boucle soit variable au regard de chaque fichier traité et ...ou je coince.

.InlineShapes.AddOLEObject ClassType:="AcroExch.Document.DC", _
FileName:=MyName, LinkToFile:=False, DisplayAsIcon:=True, IconFileName:= _
"C:\windows\Installer\{AC76BA86-7AD7-1036-7B44-AC0F074E4100}\PDFFile_8.ico" _
, IconIndex:=0, IconLabel:="Test.pdf"

MyName = Left(MyName, intPos - 1) 'je ne retiens que la partie du nom que je veux accoler à la nouvelle extension
ActiveDocument.SaveAs2 FileName:=chemin & "\" & MyName & ".docx" 'enregistré-sous au format docx dans le répertoire "Chemin"
ActiveDocument.Close 'je referme le document actif une fois celui-ci enregistré
End With
MyName = Dir()
Wend 'je boucle sur le fichier suivant
MsgBox "fin du traitement"

J'espère avoir été suffisamment clair, toute modification ou suggestion sera la bienvenue
Merci d'avance pour votre temps et pour votre aide
Rénato

N.B. je suis sous office 2013

 

[Staple1600]

Bonsoir le fil

Renato
ActiveDocument.SaveAs2 strPath & "\" & DossierExport & "\" & strName & ".docx"
Nul besoin de sagacité... juste une bonne paire de lunettes
Il suffit d'enregistrer en *.docm (au lieu de .docx)

 

[Rénato]

re le Forum et Staple

même avec mes progressives...et ActiveDocument.SaveAs2 strPath & "\" & DossierExport & "\" & strName & ".docm"
ce coup-ci le problème persiste....mêmes symptomes que ceux décrits plus haut dans mon message de ce jour 21h45

Merci pour vos conseils
Rénato

 

[Staple1600]

Re

Renato
Je suppose que tu utilises ton propre code et non pas ma Version4 modifiée comme précedemment préconisé, non?

 

[Rénato]

Re STAPLE

Non non, j'utilise bien la V4 que j'ai même montée d'indice car j'ai apporté qq compléments, la voici :

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'aménagée par Rénato - Source XLD STAPLE 1600 30/10/2019
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Sub WRD_Inserer_En_Tant_Qu_Objet_V5()
Dim strPath$, strFullName$, fich$, DossierExport$
DossierExport = "DossExp"
On Error GoTo ErrHandler
With Application.FileDialog(4)
.AllowMultiSelect = 0: .Title = "Choisir le répertoire"
If .Show = -1 Then strPath = .SelectedItems(1)
End With
If strPath = "" Then Exit Sub
DossierExport = InputBox("Nom du dossier pour la compilation des fichiers?", "Création dossier")
CreateFolder strPath & "\" & DossierExport
fich = Dir(strPath & "\*.*")
Do While fich <> vbNullString
strFullName = strPath & "\" & fich
strName = Split(fich, ".")(0)
strExt = UCase(Split(fich, ".")(1))
Select Case strExt
Case "PDF"
strClass = "AcroExch.Document"
strIco = "C:\WINDOWS\Installer\{AC76BA86-1033-F400-7760-000000000003}\_PDFFile.ico"
Case "XLS", "CSV", "XLSX", "XLSM"
strClass = "Excel.Sheet"
strIco = "C:\WINDOWS\Installer\{91140000-0011-0000-0000-0000000FF1CE}\xlicons.exe"
Case "DOC", "DOCX", "DOCM"
strClass = "Word.Document"
strIco = "C:\WINDOWS\Installer\{91140000-0011-0000-0000-0000000FF1CE}\wordicon.exe"
Case Else:
strClass = "Package"
strIco = "C:\WINDOWS\system32\packager.dll"
End Select
Documents.Add
'XXXXXXXXXXXXXXXXXXXXXXx
Selection.TypeText Text:=fich 'ajoute le titre du fichier dans le document word à côté du package
'XXXXXXXXXXXXXXXXXXXXXXXXX
ActiveDocument.Range(Start:=startRange).InlineShapes.AddOLEObject ClassType:=strClass, _
FileName:=strFullName, IconFileName:=strIco, IconIndex:=0, _
IconLabel:=fich, LinkToFile:=False, DisplayAsIcon:=True
ActiveDocument.SaveAs2 strPath & "\" & DossierExport & "\" & strName & ".docm"
ActiveDocument.Close True
fich = Dir()
Loop
MsgBox "Fin du traitement", vbOK, "Message Utilisateur"
Exit Sub
ErrHandler:
MsgBox "Aucun fichier dans le dossier choisi!", vbCritical, "Erreur"
End Sub
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Complément indispensable à WRD_Inserer_En_Tant_Qu_Objet - 30/10/2019
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Sub CreateFolder(sFolder As String)
If Len(Dir(sFolder, vbDirectory)) = 0 Then
MkDir sFolder
End If
End Sub

Dsl pour la dérange.
@ plus tard peut être....sinon bonne nuit.

 

[Staple1600]

Re

Et avec cette modif, cela donne quoi?
ActiveDocument.SaveAs2 strPath & "\" & DossierExport & "\" & strName & ".docm", 20

 

[Rénato]

Bonjour le fil, Staple

Je suis désolé, mais un message d'erreur de compilation m'est retourné avec ce complément.
Je suis surpris de la présence d'un ] sans un [ avant dans le code...du coup j'ai essayé différentes combinaisons mais sans réussite.

Cordialement

 

[Staple1600]

Bonjour le fil, Renato

Renato
Désolé, c'était une erreur de formatage de mon message (mauvais balisage BBCODE)
J'ai édité mon précédent message.
Désormais la ligne de code VBA est propre.
Je te laisse retester (sauf si tu avais déjà corriger la ligne comme je viens de le faire)

 

[Rénato]

Déjà sur le pont STAPLE....mais c'est formidable !
Malheureusement le fait d'ajouter ce bout de code, n'a rien changé à mon souci du traitement des "docm"
Belle journée à tous
Rénato

 

[Staple1600]

Re

Essaies ce petit test (juste poiur insérer un seul *.docm)
NB: Pour ce test, tu dois sélectionner le fichier (pas le dossier)
(Par défaut, le code pointe sur CurDir (chemin en cours))

Sub PetitTestMatinal()
Dim Fichier_Test, a, strClass$, strIco$, fich$
strClass = "Package"
'strIco = "C:\WINDOWS\system32\packager.exe" 'word 2003
strIco = "C:\WINDOWS\system32\packager.dll" ' version > à word 2003
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False: .InitialFileName = CurDir: .Filters.Clear
    .Filters.Add Description:="Tous Fichiers", Extensions:="*.*", Position:=1
    .Title = "Choisissez un fichier"
    If .Show = -1 Then Fichier_Test = .SelectedItems(1) Else Fichier_Test = 0
End With
a = Split(Fichier_Test, "\"): fich = a(UBound(a))
'Pas de fichier sélectionné
If Fichier_Test = 0 Then
MsgBox "Aucun fichier sélectionné!", vbCritical, "Erreur"
Exit Sub
End If
'insertion fichier choisi
Selection.InlineShapes.AddOLEObject _
    ClassType:=strClass, FileName:=Fichier_Test, _
    LinkToFile:=False, DisplayAsIcon:=True, _
    IconFileName:=strIco, IconLabel:=fich
End Sub

Ensuite enregistres manuellement le document actif avec le *.docm inséré.
Puis ferme-le et rouvres-le.
Si tu cliques sur le fichier inséré, il est exploitable ou pas?

 

[Rénato]

Re le fil et re STAPLE

En effet, ça marche. Inconvénient, le package vient s'incruster dans le fichier word qui porte la macro. Mais si je fais un enregistré sous manuel, lorsque je rouvre le fichier, je retrouve bien le docm encapsulé et il est exploitable.
Je reprendrai le fil ce soir, j'enfile mon costume de papa.
Merci encore pour tes recherches

Rénato

 

[Staple1600]

Re

Ce test était juste là pour confirmer mon soupçon (rien de de plus)
C'est la ligne VBA d'enregistrement en *.docm qui pose problème.
(puisque cela fonctionne en manuel)

Petite question subsidiaire
Quel est le but recherché?
(Dans quel contexte professionnel, ce mode opératoire s'impose-t-il?)

On est bien loin à mon sens de ce precieux principe: le K.I.S.S

 

[Rénato]

Re Staple,
L’objectif de tous ces packages (j’en aurais plusieurs milliers), c’est de pouvoir les importer dans un outil de gestion documentaire.
Ceci car leur format d’origine n’est pas accepté dans cet outil de gestion et qu’une fois packagé en docx oui.
Du coup, une dernière idée me traverse l’esprit, dans le cas d’un docm, ne peut on pas simplement le recopier dans le répertoire d’export sans pour autant le packager et ensuite, que la macro se poursuive avec le traitement des fichiers suivants ?
Si ceci ne t’inspire pas, nous en resterons là.
Et merci pour tout
Rénato

 

[Staple1600]

Re

Et comment se nomme cet outil de gestion documentaire?
Car il suffirait peut être de simplement archiver le contenu du répertoire à traiter dans un fichier archive (supporté par le dit outil), non ?

PS: Que cela m'inspire ou pas ne change rien à la donne.
Je réponds dans les fils où le vent me porte selon mes envies.

 

[Rénato]

Re Staple
Il s’agit d’une plateforme de type Documentum.
Et ce qui m’est demandé c’est de produire les documents qui ne répondent pas au format d’entrée, encapsulés dans des docx. Voilà le pourquoi de ma demande.
Au plaisir de te recroiser
Rénato