* Bonjour, *

Je crée une macro qui permet de sauvegarder et de supprimer les fichiers attachés. Cependant, afin de faciliter l'accès à ses fichiers, je garde une traces de ces derniers au bas des mails en utilisant des hyperliens. Pour certains fichiers qui comportent des caractères spéciaux (tels que le "#"), les hyperliens ne fonctionnent pas. Les espaces sont alors remplacés par des "%20" et les "#" devraient être remplacés par des "%23". Mais ce n'est pas le cas.

Pour un fichier s'appelant: "test #12" localisé sur
"file:///C:/Documents and Settings.../test/test #12.xls

Lorsque je mets le curseur sur l'hyperlien, il indique
"file:///C:/Documents%20and%20Settings.../test/test%20#12.xls
Et si l'on essaie de cliquer, il n'arrive pas à l'ouvrir.
Y a-t-il une façon de contourner ce problème ?

J'utilise le code suivant dans un module de Outlook
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
78
79
80
81
82
 
 
Public Sub SaveDeleteAttachments()
 
' Ask the user to select a file system folder for saving the attachments
Dim objOL As Outlook.Application
Dim objSelection As Outlook.Selection
Dim oShell As Object
Dim fsSaveFolder As Object
Dim sSavePathChar(1 To 300) As String
 
Set oShell = CreateObject("Shell.Application")
Set fsSaveFolder = oShell.BrowseForFolder(0, "Please Select a Save Folder:", 1)
'Set fsSaveFolder = oShell.BrowseForFolder(0, "Please Select a Save Folder:", 1, "V:\")
If fsSaveFolder Is Nothing Then Exit Sub
 
' Note:  BrowseForFolder doesn't add a trailing slash
' Ask the user to select an Outlook folder to process
 
 ' Iteration variables
Dim msg As Outlook.MailItem
Dim att As Outlook.Attachment
Dim sSavePathFS As String
Dim sDelAtts
 
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
 
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
 
'' Set the Attachment folder.
'strFolderpath = fsSaveFolder.Self.Path & "\"
 
For Each msg In objSelection
  sDelAtts = ""
  ' We check each msg for attachments as opposed to using .Restrict("[Attachment] > 0")
  ' on our olPurgeFolder.Items collection.  The collection returned by the Restrict method
  ' will be dynamically updated each time we remove an attachment.  Each update will
  ' reindex the collection.  As a result, it does not provide a reliable means for iteration.
  ' This is why the For Each loops will not work.
 
  If msg.Attachments.Count > 0 Then
    ' This While loop is controlled via the .Delete method
    ' which will decrement msg.Attachments.Count by one each time.
    While msg.Attachments.Count > 0
      ' Save the file
      sSavePathFS = fsSaveFolder.Self.Path & "\" & msg.Attachments(1).FileName
      'To handle cases where files names already exist in the directory
      msg.Attachments(1).SaveAsFile sSavePathFS
 
      ' Build up a string to denote the file system save path(s)
      ' Format the string according to the msg.BodyFormat.
      If msg.BodyFormat <> olFormatHTML Then
        sDelAtts = sDelAtts & vbCrLf & "<file://" & sSavePathFS & ">"
      Else
        sDelAtts = sDelAtts & "<br>" & "<a href='file://" & sSavePathFS & "'>" & sSavePathFS & "</a>"
      End If
      ' Delete the current attachment.  We use a "1" here instead of an "i"
      ' because the .Delete method will shrink the size of the msg.Attachments
      ' collection for us.  Use some well placed Debug.Print statements to see
      ' the behavior.
      msg.Attachments(1).Delete
    Wend
    ' Modify the body of the msg to show the file system location of
    ' the deleted attachments.
    If msg.BodyFormat <> olFormatHTML Then
      msg.Body = msg.Body & vbCrLf & vbCrLf & "Attachments Deleted:  " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To:  " & vbCrLf & sDelAtts
    Else:
      msg.HTMLBody = msg.HTMLBody & "<p></p><p>" & "Attachments Deleted:  " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To:  " & vbCrLf & sDelAtts & "</p>"
    End If
    ' Save the edits to the msg.  If you forget this line, the attachments will not be deleted.
    msg.Save
  End If
Next
 
Set oShell = Nothing
Set fsSaveFolder = Nothing
Set objSelection = Nothing
Set objOL = Nothing
 
End Sub
* Merci *