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

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

tomd
nováček
Příspěvky: 2
Registrován: březen 12
Pohlaví: Nespecifikováno

VBA Ukládání přílohy+přejmenování

Příspěvekod tomd » 13 dub 2018 09:56

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
Uživatelský avatar
elninoslov
Level 1.5
Level 1.5
Příspěvky: 140
Registrován: červen 13
Pohlaví: Muž

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

Příspěvekod elninoslov » 13 dub 2018 11:06

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


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Přejmenování listu VBA Excel2016
    od PoPa » 27 zář 2017 09:12 » v Kancelářské balíky
    4
    384
    od elninoslov
    27 zář 2017 10:27
  • Přejmenování složky v C:\Users
    od Con91 » 11 črc 2018 16:54 » v Windows 10, 8, 7, Vista, XP…
    4
    292
    od petr22
    12 črc 2018 14:20
  • Hromadné přejmenování hudebních souborů
    od Marketcb » 02 led 2018 08:06 » v Vše ostatní (sw)
    4
    311
    od xbs
    02 led 2018 09:46
  • Přejmenování souboru user32.dll
    od DaFy9 » 27 úno 2018 14:39 » v Vše ostatní (sw)
    2
    272
    od ITCrowd
    27 úno 2018 16:58
  • Z gmailu nejdou z ničeho nic odesílat přílohy typu .xlsm, .xltm
    od simona88 » 29 črc 2017 21:38 » v Vše ostatní (hw)
    3
    306
    od faraon
    30 črc 2017 21:20

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot], PetrPav a 2 hosti