VBA, déplacer un pdf

[Dim.Reichart]

Coucou,
C'est encore moi (quand on aime, on ne compte pas!)
J'ai un souci avec une autre macro.
Cette fois, je veux déplacer les PDF créés avec la macro précédentes (pour ceux qui ont suivis).
Je met un fichier sur lequel je m'entraine par principe, mais ca ne servira pas a grand chose puisque vous n'avez pas les PDF ni les dossiers concernés.
Donc, voici le code, cela devrait être plus utile.

Option Explicit
Sub test()

Dim Cel As Long, Nom As String, Lien As String, Fich As String, Dest As String
Cel = 1
Nom = Cells(Cel, 1).Value
Fich = ThisWorkbook.Path & Range("a1").Hyperlinks(1).Address
Lien = ThisWorkbook.Path & "\Archives\" & Range("b1") & "\" & Year(Date) & "\"
Dest = Lien & Nom & ".pdf"
'Créer les dossiers et sous dossiers
On Error Resume Next
MkDir (ThisWorkbook.Path & "\Archives")
On Error Resume Next
MkDir (ThisWorkbook.Path & "\Archives\" & Range("b1"))
On Error Resume Next
MkDir (Lien)

FileCopy Fich, Dest
'Kill Fich
'rediriger le lien
ActiveSheet.Hyperlinks.Add anchor:=Cells(Cel, 1), Address:=Dest, TextToDisplay:=Nom
End Sub

La macro se déroule bien, je n'ai pas d'erreur et le lien est renommé sauf que le PDF n'a pas de copie dans le nouveau fichier archive...
J'ai mis la ligne kill en commentaire pour éviter d'avoir a recréer des PDF à chaque essai.
Si vous avez une idée de ce qui ne fonctionne pas, je vous écoute.
Merci d'avance.

 

[Dim.Reichart]

Bonjour,
En plaçant msgbox Fich avant la création des dossiers, j'ai pu comparer la chaine de caractères à l'adresse réelle du dossier.
Et il semblerait que Hyperlinks.Address renvoie une adresse avec des / alors que mon adresse dossier contient des \, et que du coup, ça ne fonctionne pas.
Je vais essayer avec Replace pour remettre les \

EDIT: Ca fonctionne, voici le code:

Option Explicit
Sub test()

Dim Cel As Long, Nom As String, Lien As String, fichier As String, Fich As String, Dest As String
Cel = 1
Nom = Cells(Cel, 1).Value
fichier = Range("a1").Hyperlinks(1).Address
Fich = ThisWorkbook.Path & "\" & Replace(fichier, "/", "\", 1, 2)
Lien = ThisWorkbook.Path & "\Archives\" & Range("b1") & "\" & Year(Date) & "\"
Dest = Lien & Nom & ".pdf"

'Créer les dossiers et sous dossiers
On Error Resume Next
MkDir (ThisWorkbook.Path & "\Archives")
On Error Resume Next
MkDir (ThisWorkbook.Path & "\Archives\" & Range("b1"))
On Error Resume Next
MkDir (Lien)

FileCopy Fich, Dest
Kill Fich
'rediriger le lien
ActiveSheet.Hyperlinks.Add anchor:=Cells(Cel, 1), Address:=Dest, TextToDisplay:=Nom

End Sub