Skript na kontrolu excelového souboru
Napsal: 02 úno 2016 15:57
Ahoj Všem
Prosím o radu se skriptem, který vytvořil uživatel "ITCrowd".
Tento skript provádí kontrolu a odeslání excelového souboru na dané emaily. Dokud byl daný soubor uložen ve verzi excelu 2003 /soubor.xls/, vše fungovalo jak má. Nyní došlo k uložení souboru v novém formátu /soubor.xlsx/ a bohužel skript už nepozná změnu souboru.
Pozná to jen pokud je soubor s dané složky smazán a opět vytvořen.
Poradí prosím někdo?
Prosím o radu se skriptem, který vytvořil uživatel "ITCrowd".
Tento skript provádí kontrolu a odeslání excelového souboru na dané emaily. Dokud byl daný soubor uložen ve verzi excelu 2003 /soubor.xls/, vše fungovalo jak má. Nyní došlo k uložení souboru v novém formátu /soubor.xlsx/ a bohužel skript už nepozná změnu souboru.
Pozná to jen pokud je soubor s dané složky smazán a opět vytvořen.
Poradí prosím někdo?
Kód: Vybrat vše
'**********************************************
'* Script testuje soubor excelu na změnu *
'* Pokud je soubor změněn odešle jej e-mailem *
'* vytvořeno pro PC-Help *
'* *
'* Etienna@Script v1.0 *
'**********************************************
Option Explicit
Dim fso, oFile, Text, Pause
Dim objOutlk 'Outlook
Dim objMail 'Email item
Dim strMsg
Const olMailItem = 0
Const file = "\\CZSTET02.steti.local\DISK_G\GROUPS\Departments\Provoz Steti\BP-Balici papiry\Veřejné\Dovolená a rozpisy BP PS 3,6\Rozpis směn PS 3,6.xlsx" ' hlídaný soubor na změnu
Pause = 30 'Počáteční zpoždění v ms
WScript.Sleep Pause
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set oFile = fso.GetFile(file)
Text = "Soubor " & oFile.Name & " rozpis byl změněn. Dojde k automatickému odeslání"
'test xls
If oFile.Attributes AND 32 Then
MsgBox Text, vbOKOnly + vbInformation, "Upozornění"
Odeslani
oFile.Attributes = oFile.Attributes XOR 32
End If
Sub Odeslani
'Nová zpráva
Set objOutlk = createobject("Outlook.Application")
Set objMail = objOutlk.createitem(olMailItem)
objMail.To = "Simunek.Jarosl@email.cz
'objMail.cc = " " 'Zde adresa pro kopii; objMail.bcc pro skrytou adresu
'Předmět
objMail.subject = "Rozpis " & cstr(day(now)) & ". " & cstr(month(now)) & ". " & cstr(year(now))
'Zpráva
strMsg = "Změna rozpisu." & vbcrlf
strMsg = strMsg & "Miroslav Šimánek.Mistr BP."
strMsg = strMsg & "Toto je informativní email, směrodatný je rozpis v daném umístění na síti Mondi. Pro info - je nastavená kontrola rozpisu každých 48 hod.pokud dojde ke změně, je automaticky odeslán, proto je vždy nejaktuálnější ten, který přijde jako poslední. J.Šimůnek"
'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
Set fso = Nothing
Set oFile = Nothing
