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 2
Level 2
Příspěvky: 165
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í složky v C:\Users
    od Con91 » 11 črc 2018 16:54 » v Windows 10, 8, 7, Vista, XP…
    4
    491
    od petr22
    12 črc 2018 14:20
  • Přejmenování souboru user32.dll
    od DaFy9 » 27 úno 2018 14:39 » v Vše ostatní (sw)
    2
    292
    od ITCrowd
    27 úno 2018 16:58
  • Hromadné přejmenování hudebních souborů
    od Marketcb » 02 led 2018 08:06 » v Vše ostatní (sw)
    4
    362
    od xbs
    02 led 2018 09:46
  • Ukládání fotek na nepoužívaný HDD a výběr nové televize
    od Roidoc » 25 úno 2018 17:19 » v Vše ostatní (hw)
    1
    349
    od petr22
    25 úno 2018 17:30
  • Excel VBA
    od Dawyck » 06 led 2018 21:35 » v Kancelářské balíky
    1
    333
    od xlnc
    07 led 2018 14:17

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

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 0 hostů