arkadaşlar merhaba
Outlook a gelen mail eklerini kod ile pc deki klasöre aktarıyorum ancak maile gelen dokuman.htm dosyasını konundaki bilgi ile değiştirip abcf.htm olarak kaydediyor bunu abcd.pdf olarak kaydını yaptırabilirmiyiz.
kullandığım kod:
On Error Resume Next
Dim saveFolder As String
saveFolder = "F:\Users\himmety\Desktop\ing\" 'Maillerin kaydedileceği dosya
Dim dateFormat
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & degistir(itm.Subject) & "-" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
Function degistir(yazi As String)
On Error Resume Next
yk = "_"
yazi = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(yazi, ":", yk), "*", yk), "\", yk), "/", yk), "<", yk), ">", yk), "|", yk), """", yk), "?", yk)
degistir = yazi
End Function
Outlook a gelen mail eklerini kod ile pc deki klasöre aktarıyorum ancak maile gelen dokuman.htm dosyasını konundaki bilgi ile değiştirip abcf.htm olarak kaydediyor bunu abcd.pdf olarak kaydını yaptırabilirmiyiz.
kullandığım kod:
On Error Resume Next
Dim saveFolder As String
saveFolder = "F:\Users\himmety\Desktop\ing\" 'Maillerin kaydedileceği dosya
Dim dateFormat
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & degistir(itm.Subject) & "-" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
Function degistir(yazi As String)
On Error Resume Next
yk = "_"
yazi = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(yazi, ":", yk), "*", yk), "\", yk), "/", yk), "<", yk), ">", yk), "|", yk), """", yk), "?", yk)
degistir = yazi
End Function
