VBA Ukládání přílohy+přejmenování Vyřešeno

[tomd]

Ahoj,
mám v Outlooku 2010 funkční pravidlo a skript pro ukládání příloh.
Potřeboval bych do scriptu přidat přejmenování ukládaného souboru, přidat ke jménu aktuální datum a čas.
Doručené přílohy se vždy jmenují "untitled.png", tudíž se neukládají.
Potřebuji aby se jmenovaly třeba "untitled180413_094600.png", aby měl prostě každý soubor unikátní název.
V podstatě jedno jaký.
Nejsem v VBA sběhlý, byl by někdo tak laskav a poradil co přidat?
Předem moc děkuji.

Kód: Vybrat vše

Sub SaveAttachments2(myMail As MailItem)
Dim vFrom As String, vSubject As String
Dim vFile As Attachment
 
vFrom = myMail.ReceivedByName
vSubject = myMail.Subject
 
If myMail.Attachments.Count > 0 Then
        For i = 1 To myMail.Attachments.Count
            Set vFile = myMail.Attachments(i)
            If LCase(vFile.FileName) Like "*.png" Then
            vFile.SaveAsFile "C:\ris\" & vFile.FileName
            End If
        Next i
End If
 

Set myMail = Nothing
Set vFile = Nothing
End Sub


[Reklama]

[elninoslov]

Pr.

Kód: Vybrat vše

Sub SaveAttachments2(myMail As MailItem)
Dim Datum As Date, Citac As Long
  With myMail
    Datum = .LastModificationTime
    For i = 1 To .Attachments.Count
      With .Attachments(i)
        If Right$(LCase(.FileName), 4) = ".png" Then
          Citac = Citac + 1
          .SaveAsFile "C:\ris\" & Replace(.FileName, ".png", Format(Datum, "yymmdd_hhmmss") & "_" & Citac & ".png")
        End If
      End With
    Next i
  End With
End Sub