Automatické odesílání emailu s přílohou

[Uziv00]

Tak tady to je:

Kód: Vybrat vše

'***********************************************
'* Skript odešle určený soubor na danou adresu *
'* Jméno souboru si vytváří z aktuálního data  *
'*                                             *
'*        Vytvořeno pro PC-HELP                *
'*                                             *
'*          Etienn@Script v1.0                 *
'***********************************************

' Deklarace proměnných
Option Explicit
Dim cislotydne, Mesic, Jmeno, Cesta, file, fso
Dim CisloDne, objOutlk, objMail, strMsg, olMailItem

cislotydne = DatePart ("ww", Now())
Mesic = MonthName(Month(Now()))
Jmeno = cislotydne & ". týden - " & Mesic
Cesta = "C:\Users\Thor\Documents\REPORT\" & Jmeno & ".docx"
file = Cesta
'MsgBox file
CisloDne = Weekday(Now())
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(file) Then
  If CisloDne <> 1 Or CisloDne <> 7 Then Odeslani
Else
  MsgBox "Soubor " & file & " nenalezen", vbOKOnly + vbCritical, "Chybová zpráva"
  WScript.Quit
End If

Sub Odeslani
'Nová zpráva
   Set objOutlk = createobject("Outlook.Application")
   Set objMail = objOutlk.createitem(olMailItem)
   objMail.To = "muj.mail@neco.cz" 'zde doplnit adresu
   objMail.cc = "" 'Zde adresa pro kopii; objMail.bcc pro skrytou adresu
'Předmět
   objMail.subject = "REPORT " & cstr(day(now)) & ". " & cstr(month(now)) & ". " & cstr(year(now))
'Zpráva   
   strMsg = "První řádek zprávy" & vbcrlf
   strMsg = strMsg & "Druhý řádek zprávy"
'Příloha
   objMail.attachments.add(file)
   objMail.body = strMsg
   'objMail.display 'Zobraz před odesláním, jinak rovnou objMail.Send pro odeslání
   objMail.Send
End sub
'Clean up
Set objMail = Nothing
Set objOutlk = Nothing


Kód zkopíruj do textového editoru (notepadu) - nepoužívat Word a podobně!! a ulož. Zedituj e-mailovou adresu, předmět zprávy (teď to píše REPORT a aktuální datum) a první a druhý řádek zprávy. Pokud žádný text nechceš, pak před řádky strMsg dej apostrof ('). Ulož.
Změň příponu .txt na .vbs. Poklepáním na soubor se provede odeslání. Pokud skript soubor nenalezne, vypíše zprávu.
Kontrolu tvorby jména souboru lze zapnout odstraněním apostrofu u řádku -'MsgBox file-. (Slouží pro odladění).
Spuštění souboru v potřebný čas zajistíš přes plánovač úloh. Skript si sám kontroluje, zda není sobota, nebo neděle, v tom případě report neodešle.
Doporučuji nejdřív vyzkoušet na svůj e-mail, spustit poklepáním a v případě, že bude vše v pořádku, změnit e-mailovou adresu na správnou a zařadit do úloh.
V případě závad se klidně ozvi.

[Reklama]

[thorkaufman]

Dekuji moc, jsi opravdu mistr! Hned v pondeli to v praci zkusim.

Odesláno z mého GT-S5830 pomocí Tapatalk 2

[jirkas007]

Dobrý den,

tento skript jsem použil a funguje na jedničku!

Jen nemůžu přijít na to, jak odeslat 2 a více souborů v jednom emailu. Mohl by jste mi prosím pomoct?

Děkuji Jiří Pešek

[Uziv00]

Vítej na PC-HELP!
Snad ano.
Pokud jsi četl tohle téma od začátku, pak musíš přesně popsat, jak se skript má chovat - viz. tvorba jména souboru.
Pokud chceš jen tak nějaký soubor přihodit, pak by mohlo stačit ho přidat pomocí objMail.attachments.add(....), pozor, soubor musí existovat!

[Dody]

Dobrý den,
tento skript používám skoro dva roky a funguje výborně , ale teď jsme přešli na jiného poštovního klienta konkrétně Mozilla Thunderbird 60.0 . Dal by se upravit pro tohoto klienta ?
Děkuj

[Uziv00]

Zkusím se na to podívat. Nemůžu zaručit, thunderbird neposkytuje objekt jako outlook.

[zeus]

A neslo by pak vyuzit mailto: ?

[Uziv00]

Zkusit to můžu.
Jen se to nepropíše do odeslané pošty v thunderbirdu.

[Uziv00]

Takže - mailto nepůjde použít, nenašel jsem žádnou cestu, jak přiložit soubor a odeslat bez interakce uživatele.
Můžu použít objek CDO.Message, tam se určitě nezapíše do odeslané pošty v thunderbirdu. Navíc je zde komplikace s nastavením SMTP, to by nemuselo klapnout.
Nicméně jsem našel možnost, jak odeslat email z thunderbirdu pomocí příkazu. Pracuju na tom.

[Uziv00]

Ahoj,
takže verze pro thunderbird:

Kód: Vybrat vše

  MsgBox "Soubor " & file & " nenalezen", vbOKOnly + vbCritical, "Chybová zpráva"
  Set fso = Nothing
  WScript.Quit
End If

Sub Odeslani
Dim Predmet, Prikaz, Zprava, objShell
Set objShell = WScript.CreateObject("WScript.Shell")
'Předmět
   Predmet = "REPORT " & cstr(day(now)) & ". " & cstr(month(now)) & ". " & cstr(year(now))
'Zpráva   
   Zprava = "První řádek zprávy" & vbcrlf
   Zprava = Zprava & "Druhý řádek zprávy"
' Vytvoření příkazu
Prikaz = "thunderbird -compose " & chr (34) & "to='ja@mujmail.cz',subject=" & Chr (39) & _
Predmet & Chr(39) & ",body=" & Chr (39) & Zprava & Chr (39) & ",attachment=" & Chr (39) & file & Chr (39) & Chr (34)
'WScript.Echo Prikaz
objShell.Run Prikaz
Set objShell = Nothing
End sub
'Clean up
Set fso = Nothing

Bohužel vyžaduje interakci - tedy otevře vyplněné okno thunderbirdu a je nutno stisknout odeslat.
Zkopíruj si vše v okně a nahraď textem vše od řádku Else
V řádku Prikaz ja@mujmail.cz nahraď skutečnou mailovou adresou.

[Dody]

Ahoj takže moc děkuju skript jde a takhle jak to je mi to stačí. Ještě jednou dík.

[Uziv00]

Není zač Od toho tu jsme