Pourcentage dans nom de pdf

Bonjour,

J'ai une macro VBA qui vient prendre des pdf dans un dossier sur Sharepoint, et les mets dans des mails individualisés. Le problème c'est que pour les pdf ayant des espaces, il remplace l'espace par un "%" au moment de l'insrére en pièce jointe.

Voici la macro qui semble créer cette anomalie:

Sub MailFonctionMBB()

Dim i As Long, Cpt As Long, j As Long
Dim Ar() As String
Dim Liste As String
Dim Erreur As String
Dim XLFichier As Workbook
Dim fichier As String

MsgBox ("Pensez à bien mettre Outlook en mode hors connexion")

Cpt = 0
For i = 4 To ThisWorkbook.Sheets.Count 'on compte le nombre d'onglet


If Sheets(i).Range("U5").Value = "1" Then 'on regarde si l'onglet parcouru a U5=1
Sheets(i).Select 'si oui on selectionne l'onglet
Sheets(i).Visible = True
ReDim Preserve Ar(Cpt)
fichier = Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 5) 'on enregistre le nom du fichier sans le .xls

Ar(Cpt) = Sheets(i).Range("S5").Value 'on stocke la valeur S5 dans la case Cpt du tableau Ar
nom = Ar(Cpt) & ".pdf" 'on enregistre le nom de S5 + .pdf

Erreur = "" 'si la macro trouve le "1" dans la cellule U5 et qu'il y a bien un nom de la personne dans la cellule S5 alors
'il n'y a pas d'erreur


Liste = RecupMail(Ar(Cpt)) 'on appelle la fonction RecupMail qui enregistre dans Liste les mails correspondant
' au nom S5 dans le fichier global (voir plus bas)

If Liste = "" Then 'si la liste est vide
Erreur = "Erreur adresse d'envoi "
Liste = "[adresse masquée]" 'on envoie l'erreur à l'équipe
End If

'MsgBox ("la liste avant envoi:")
MsgBox Liste

' la plage de cellules à envoyer
ActiveSheet.Range("A1:D1").Select
ActiveWorkbook.EnvelopeVisible = True


Dim v As String

v = ThisWorkbook.Sheets(1).Range("V7")



With ThisWorkbook.ActiveSheet.MailEnvelope

.Introduction = "Dear xx," & vbLf & " You will find enclosed x." & vbLf & "Best Regards," & vbLf & "signature."


'Destinataires
.Item.To = Liste
'En copie
.Item.CC = "[adresse masquée]"
'Objet
.Item.Subject = Erreur & fichier & " - " & Ar(Cpt)
'Enlève les pièces jointes éventuellement ajoutées précédement
Do While .Item.Attachments.Count > 0
.Item.Attachments(1).Delete
Loop
'on va chercher la pièce jointe dans le dossier pdf par mail, nom = nom de la pj

.Item.Attachments.Add ActiveWorkbook.Path & "\pdf par mail\" & nom
'Accusé de réception
.Item.OriginatorDeliveryReportRequested = True
'Accusé de lecture
.Item.ReadReceiptRequested = True
'Envoi
.Item.Send

End With



Cpt = Cpt + 1 'on passe à la case suivante du tableau Ar


End If

Next i 'on passe à l'onglet d'après

'Set XLFichier = Nothing

End Sub

Function RecupMail(name As String)

Dim j As Long

Dim XLFichier As Workbook

Dim mails As String

Dim nom As String

nom = name

mails = ""

'on ouvre le fichier global

Set XLFichier = Workbooks.Open("[adresse masquée avec 222 caractères]")

For j = 2 To 240 'on parcours les lignes 2 à 240

'Si dans la colonne C on retrouve le nom S5 et qu'il y a un dans la colonne AD(C'est là que j'ai tenté !

If XLFichier.Worksheets(1).Range("C" & j).Value = nom And XLFichier.Worksheets(1).Range("AD" & j).Value = "1" Then

'on enregistre la valeur correspondante de la colonne U (les mails) et on ajoute un ;

mails = mails & XLFichier.Worksheets(1).Range("U" & j).Value & "; "

End If

'on passe à la prochaine ligne

Next j

'on ferme le fichier global

Set XLFichier = Nothing

Windows("fichier global.xlsx").Close savechanges:=False

'on renvoi tous les mails à la liste à envoyer

RecupMail = mails

End Function

Une idée sur comment corriger la vba ?

Merci!

Bonjour,

Comme c’est le fonctionnement normal du Sharepoint, il ne doit être possible de changer ça.

Tu peux contourner le problème en enregistrant le pdf sur le disque avant de l’envoyer. Au pire, tu pourras remplacer les % par des espaces quand le fichier sera sur le disque.

Benead