Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Word Discussion :

Identifier des liens morts et lister dans cvs.


Sujet :

VBA Word

  1. #1
    Candidat au Club
    Identifier des liens morts et lister dans cvs.
    Bonjour a tous !

    J'ai cherche, cherche... et j'avoue que pour Excel j'ai trouve pas mal de solutions mais Le vba Word ...

    Je voudrais appeler un code permettant de :

    1-analyser tous les liens de mon document word
    2-reperer les broken links (liens casses ? morts)
    3-en cas de lien mort, lister le tout dans un ficher CVS

    je suis un peu perdue sur le coup, des idees ?

    Merci a tous d'avance

  2. #2
    Expert éminent
    Salut tartopwaro,

    Il est possible de lister tous les liens d'un document mais il n'y a pas de méthode pour savoir si un lien pointe sur une adresse inexistante ou une page vide.

    Si tu as une méthode pour détecter un lien cassé, on peut alors faire la boucle sur tous les liens.

    @+

  3. #3
    Candidat au Club
    Bonjour,
    Desolee de ma reponse tardive.

    Je ne parle pas d'hyperliens http mais d'images (Inlineshapes)

    Ce n'est pas possible non plus ?

  4. #4
    Rédacteur/Modérateur

    Salut,

    Desolee de ma reponse tardive.
    Pourtant, tu te lève avant nous !


    C'est possible, il faut tester la source pour sa présence.

    On peut récupérer le chemin de l'image ou de l'objet avec le code suivant :

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    activedocument.InlineShapes(1).LinkFormat.SourceFullName


    Avec une boucle sur tous les objets et un test d'existence.
    On peut faire ce test avec Dir(), si le résultat est vide, c'est que le fichier n'existe pas.
    J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
    Débutez en VBA

    Mes articles


    Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !

  5. #5
    Candidat au Club


    Pourtant, tu te lève avant nous !


    Je suis expatriée japonaise jusqu'au bout des doigts ! je bosse 70h/semaines /o/

    Mon soucis c'est que j'ai du mal a debuter les macros,
    autan faires la fin, les modifs, pas de soucis, mais j'ai jamais su comment les commencer
    Si quelqu'un peut me lancer sur un debut ca m'aiderait beaucoup

    Sinon, pas d'experience en vba word.

    Excel oui, ca va, ya les colonnes blabla

    mais Word comment qu'on fait ?

    En gros le plan se resumerait comme ca :

    1-Dans le document actif, identifier les liens

    2-Puis les tester

    Si

    a- lien ok = 'donithing
    b- lien brise = appeler un cvs pour lister ce lien



    Jusqu'ici j'ai bon ?

    en farfouillant, j'ai trouve ceci

    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
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    Option Explicit
     
    Private Declare Function IsValidURL Lib "urlmon" (ByVal pBC As Long, _
    url As Byte, ByVal dwReserved As Long) As Long
    Sub x()
    '
    ' x Macro
    ' Macro recorded 7/19/2007 by David Chinell
    '
    Dim objWorkRange As Range
    Dim objField As Field
    Dim aryCode() As String
    Dim strFileName As String
    Dim AllLinksValid As Boolean
     
     
    ' Set this to handle bad file formats
     
    On Error Resume Next
     
    ' Work from the current insertion point down
     
    Set objWorkRange = ActiveDocument.Range
    objWorkRange.Start = Selection.Start
     
    ' Find all the hyperlinks
    AllLinksValid = True
    For Each objField In objWorkRange.Fields
    ' For each hyperlink, split out the filename
    If objField.Type = wdFieldHyperlink Then
     
    aryCode = Split(objField.Code, """")
    strFileName = aryCode(1)
    ' Test whether the file exists
     
    If ActiveDocument.Bookmarks.Exists(strFileName) <> True Then
    If Not ValidURL(strFileName) Then
    ' The file is missing
    objField.Select
    AllLinksValid = False
    Exit For
    End If
    End If
    End If
    Next objField
     
    Set objWorkRange = Nothing
     
    If AllLinksValid Then
    MsgBox _
    Prompt:="All links and bookmarks are valid!" & vbNewLine, _
    Buttons:=vbInformation, _
    Title:="LazyButt Tools"
    Else: _
    MsgBox Prompt:="This link is invalid:" & _
    vbNewLine & strFileName _
    , Buttons:=vbInformation _
    , Title:="LazyButt Tools"
    End If
     
    End Sub
     
     
    Function ValidURL(ByVal url As String) As Boolean
     
    Dim b() As Byte
     
    ' We need this because we're passing a Unicode string
    b = url & vbNullChar
     
    If IsValidURL(0, b(0), 0) = 0 Then
    ValidURL = True ' valid URL
    Else
    ValidURL = False ' invalid URL
    End If
     
    End Function


    mais... je sais pas... ca ne marche pas, tout est toujours valide, et puis bon il faudrait que si ca marche, ca appelle un cvs par la suite
    le fichier en question est en piece jointe...
    sans aucune image du coup, parce que ca me met un message d'erreur.
    Donc en admettant qu'on fasse un macro sur ca tous les liens devraient etres listes en erreur

  6. #6
    Rédacteur/Modérateur

    Salut,

    Point besoin d'utiliser une librairie externe.

    Essaie ce 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
    Sub TestSurImage()
    Dim oDocCSV As Document
    Dim oInSh As InlineShape
    Dim oDocAvecImages As Document
     
    'Affectation des objets
    Set oDocAvecImages = ActiveDocument
    Set oDocCSV = Documents.Add
     
    'boucle sur les images
    For Each oInSh In oDocAvecImages.InlineShapes
    'Contrôle du déroulement
    Debug.Print "Image : " & oInSh.LinkFormat.SourceFullName & " -- " & Dir(oInSh.LinkFormat.SourceFullName)
    'Test sur le fichier
        If Dir(oInSh.LinkFormat.SourceFullName) = "" Then
        'Écriture dans le document si image non présente
            oDocCSV.Range.Select
            Selection.Collapse (wdCollapseEnd)
            Selection.TypeText oInSh.LinkFormat.SourceFullName & vbCrLf
     
        End If
    Next oInSh
    'Sauvegarde du fichier texte
    oDocCSV.SaveAs2 "C:\Temp\ImageCSV.csv", wdFormatDOSText
    'fermetur et libération des objets
    oDocCSV.Close
    Set oDocCSV = Nothing
     
     
     
    End Sub
    J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
    Débutez en VBA

    Mes articles


    Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !

  7. #7
    Candidat au Club
    Bonjour :-)

    je suis entrain de tester tout ca mais il y a un bug sur cette ligne (Erreur 91)

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    Debug.Print "Image : " & oInSh.LinkFormat.SourceFullName & " -- " & Dir(oInSh.LinkFormat.SourceFullName)




    Le tout est de comprendre pourquoi du coup Oo

    edit : je crois que je suis en train de comprendre. Je suis censee changer "image : " et " -- " c'est ca ?
    re-edit : oui non je dois etre une grosse quiche sur le coup, parce que je ne comprends pas comment faire fonctionner cette fonction debug print, pourquoi il y a quelquechose qui va pas, et comment au juste elle agit.
    -> Du coup, comme ca fait 3 heures que je cherche sans comprendre, je vais prendre mon mal en patience et attendre Heureux-Oli qui arrivera peut-etre a m'expliquer (et me desembourber) ce mystere de la science vba =3


    Quelles sont les informations que je dois entrer ? (je ne connaissais pas le debug.print, alors j'ai cherche de partout mais du coup je suis pas trop avance :p)

    et puis concernant

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    'Sauvegarde du fichier texte
    oDocCSV.SaveAs2 "C:\Temp\ImageCSV.csv", wdFormatDOSText


    du coup, le fichier va etre sauvegarde dans temp de c?

    umm, comment faudrait-il que je change pour que la sauvegarde se fasse dans le dossier contenant le fichier en question ?ca marche pas pareil que dans excel avec les Active.workbook n'est-ce oas ?

  8. #8
    Rédacteur/Modérateur

    Salut,

    Il n'y a rien à changer au code, hormis le chemin pour la sauvegarde.

    Par contre, l'erreur me fait penser que tu n'as pas d'image InlineShape dans ton document, c'est pour cette raison que l'on a une erreur 91.
    J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
    Débutez en VBA

    Mes articles


    Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !

  9. #9
    Candidat au Club
    Pourtant, j'ai bien des inlineshape dans mon document.
    enfin je crois (?)

    Le dossier racine est compose de deux dossiers :

    un dossier "doc"
    un dossier "img"

    dans le dossier doc, il y a le word avec pleins de liens image qui sont justement toutes rangees dans le dossier img



    edit : oui je confirme que ce sont des Inlineshape, car j'avais monte un code pour en reduire toutes les images en pourcentage, il y a deux trois semaines
    edit 2 : je viens de reesayer, en changeant le directory du fichier aussi. Mais ca me fait effectivement une liste, sur word, pas enregistree.
    et puis au beau milieu de la liste paf le code 91 apparait sur cette ligne.
    Il n'empeche que la liste se fait !! un&#12288;petit peu !
    meme si ce n'est pas en cvs mais bon...

    edit 3 (oui ca commence a en faire des edit :p) : un cvs vierge est apparu ! du coup a l'appel du macro ca nous fait un schmilblick du genre :
    1*le code se lance, on voit que ca travaille un peu
    2* un doc non nomme se lance et affiche des noms de liens (je suppose les liens morts)
    3* un bug apparait sur la ligne mentionnee plus tot. erreur 91 au debug.print
    4* un cvs vierge apparait tout de meme

  10. #10
    Rédacteur/Modérateur

    Salut,

    je ne sais pourquoi tu as cette erreur 91.
    Si c'est possible, pourrais-tu nous mettre un fichier qui produit cette erreur ?
    J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
    Débutez en VBA

    Mes articles


    Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !

  11. #11
    Candidat au Club




    voila le dossier doc et img
    j'ai supprime un partie des images donc il est cense y avoir des erreurs de liens
    (pare que le dossier image faisait a la base 79Mo)

    Sinon le doc est en japonais, j'espere que yaura pas de soucis de lecture (quoi que on s'en fiche un peu du contenu)

    Qu'est ce que vous en pensez ?

  12. #12
    Rédacteur/Modérateur

    Salut,

    Pour la lecture, c'est pas grave, mais je ne parviens pas à faire ce que je voudrais avec le document comme mettre le bon chemin des images.

    Mais, tes images sont des champs INCLUDEPICTURE, ce qui pourrait nous permettre d'utiliser un autre mode de contrôle.

    On peut récupérer le chemin dans le contenu du champ.
    J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
    Débutez en VBA

    Mes articles


    Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !

  13. #13
    Candidat au Club
    Heureux-oli,
    je t'attendais ! avec le decalage horaire, je n'ai fais qu'attendre ton retour !

    Pourrais-tu m'expliquer plus simplement ton dernier post ?

    Si j'ai bien compris, ce qui n'allait pas dans le code c'etait le FormatLink.

    Il faudrait donc arranger le code pour une version Includepicture ?

  14. #14
    Rédacteur/Modérateur

    Salut,

    comme je ne peux pas tester ton document avec mon code.

    On peut faire une boucle sur tous les champs, tester le début du champ et si on a un Includpicture, on peut extraire le chemin de l'image et tester ce chemin.

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     
    Dim oFld As Field
    Dim stPath As String
     
    For Each oFld In ActiveDocument.Fields
        stPath = oFld.Code
        Debug.Print LTrim(Replace(stPath, "INCLUDEPICTURE ", ""))
     
    Next oFld
    J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
    Débutez en VBA

    Mes articles


    Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !

  15. #15
    Candidat au Club
    Effectivement plus d'erreur sur ce point la.

    Je n'avais pas compris que le probleme venait de LinkFormat, je restais bloquee sur le debug print.
    Merci sensei

    Du coup,

    comment adapter la partie controle du deroulement et ecriture ?
    (je suis en train de trifouiller actually, mais ca donne pas grand chose =o)
    Ca me fait un Csv vide

    Edit : Apres une discussion sur le chat avec Epitouille,
    je constate que ce n'est pas mon adaptation qui est foireuse (puisque Epitouille a fait pareil que moi, a moins qu'on se tous les deux dans l'erreur)

    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
    37
    Sub TestSurImage()
    Dim oDocCSV As Document
    Dim oFldh As Field 
    Dim oDocAvecImages As Document
    Dim stPath As String
     
    'Affectation des objets
    Set oDocAvecImages = ActiveDocument
    Set oDocCSV = Documents.Add
     
    'boucle sur les images
     
    For Each oFld In ActiveDocument.Fields
     
    'Contrôle du déroulement
     
      stPath = oFld.Code
      Debug.Print LTrim(Replace(stPath, "INCLUDEPICTURE ", ""))
     
     
    'Test sur le fichier
        If Dir(stPath) = "" Then
        'Écriture dans le document si image non présente
            oDocCSV.Range.Select
            Selection.Collapse (wdCollapseEnd)
            Selection.TypeText stPath & vbCrLf
     
        End If
    Next oFld
    'Sauvegarde du fichier texte
    oDocCSV.SaveAs2 "C:\Temp\ImageCSV.csv", wdFormatDOSText
    'fermetur et libération des objets
    oDocCSV.Close
    Set oDocCSV = Nothing
     
     
    End Sub


    Ne donne rien.
    un fichier CSV de 1ko apparait sur le coup, sans ramer pour rechercher, et a l'ouverture je constate qu'il est vide.

  16. ###raw>post.musername###
    Rédacteur/Modérateur
    Salut,

    Mea culpa,

    Je suis parti d'un champ ajouté à la main, mais le champ peut contenir autre chose, comme des commutateurs.

    J'ai corrigé 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
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
     
    Function ExtractPath(stTemp As String) As String
    Dim intStart As String
    Dim intEnd As String
     
    intStart = InStr(1, stTemp, Chr(34))
    intEnd = InStr(intStart + 1, stTemp, Chr(34))
     
    ExtractPath = Replace(Mid(stTemp, intStart + 1, intEnd - intStart - 1), "\\", "\")
     
     
     
    End Function
     
    Sub TestSurImage1()
    Dim oDocCSV As Document
    Dim oFld As Field
    Dim oDocAvecImages As Document
    Dim stPath As String
     
    'Affectation des objets
    Set oDocAvecImages = ActiveDocument
    Set oDocCSV = Documents.Add
     
    'boucle sur les images
     
    For Each oFld In oDocAvecImages.Fields
     
    'Contrôle du déroulement
     
      stPath = oFld.Code
      Debug.Print oFld.Code
     
    If Left(oFld.Code, 15) = " INCLUDEPICTURE" Then
        stPath = oFld.Code
        'Debug.Print LTrim(Replace(stPath, "INCLUDEPICTURE ", ""))
        'Debug.Print InStr(1, stPath, Chr(34))
     
        Debug.Print ExtractPath(stPath)
     
     
    'Test sur le fichier
            If Dir(ExtractPath(stPath)) = "" Then
            'Écriture dans le document si image non présente
                oDocCSV.Range.Select
                Selection.Collapse (wdCollapseEnd)
                Selection.TypeText ExtractPath(stPath) & vbCrLf
            End If
        End If
    Next oFld
    'Sauvegarde du fichier texte
    oDocCSV.SaveAs2 "C:\Temp\ImageCSV.csv", wdFormatDOSText
    'fermetur et libération des objets
    oDocCSV.Close
    Set oDocCSV = Nothing
    Set oDocAvecImages = Nothing
     
     
     
    End Sub
      0  0

  17. #17
    Candidat au Club
    Très en retard dans la réponse...

    Mais ca marche ! youhou !


    Merci Oli !!!


    Bon après, il y a des fonctions que je connais pas, mais je cherche un peu pour regarder comment tu t'y es pris et comprendre le raisonnement

  18. #18
    Rédacteur/Modérateur

    Salut,

    Demande et j'explique le code que j'ai posté.
    J'ai pas encore de décodeur, alors, postez en clair ! Comment mettre une balise de code ?
    Débutez en VBA

    Mes articles


    Dans un MP, vous pouvez me dire que je suis beau, ... mais si c'est une question technique je ne la lis pas ! Vous êtes prévenus !

  19. ###raw>post.musername###
    Candidat au Club
    Et non, ce n'est pas resolu du coup ...


    j'ai voulu ajouter une msg box en fin pour signaler si oui ou non un fichier s'etait cree...

    et un fichier se cree a chaque fois...

    meme sans erreur !!!

    Et quand j'essai de modifier le code,

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    ExtractPath = Replace(Mid(stTemp, intStart + 1, intEnd - intStart - 1), "\\", "\")

    me rapporte une erreur...

    Je vais me hara-kiri
      0  0

  20. ###raw>post.musername###
    Rédacteur/Modérateur
    Salut,

    C'est une fonction à part entière.

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    Function ExtractPath(stTemp As String) As String
    Dim intStart As String
    Dim intEnd As String
     
    intStart = InStr(1, stTemp, Chr(34))
    intEnd = InStr(intStart + 1, stTemp, Chr(34))
     
    ExtractPath = Replace(Mid(stTemp, intStart + 1, intEnd - intStart - 1), "\\", "\")
     
     
     
    End Function


    Pourquoi souhaites-tu modifier cette partie ?

    Elle ne sert qu'à extraire la chaîne de caractère qui représente le chemin de l'image.

    Son principe est simple, le chemmin est entouré de ", il suffit d'avoir leur position pour savoir où commence et où finit le texte à utiliser.

    Je récupère ces positions avec InStr().
    Je stocke ces positions dans deux variables.
    J'utilise ces variables pour l'extraction avec la fonction Mid() et j'en profite pour faire un remplacement.

    Le résultat est transmis à la procédure Sub pour traitement et inscription dans le fichier.

    Si tu souhaites un fichier différent à chaque fois, on peut utiliser le temps système pour le nom.


    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    oDocCSV.SaveAs2 "C:\Temp\" & format(Now,"yyyy-mm-dd hh-mm") & ".csv", wdFormatDOSText


    Tu auras un nouveau fichier à chaque fois.
      0  0

###raw>template_hook.ano_emploi###