-
Notifications
You must be signed in to change notification settings - Fork 0
/
excel.vbs
94 lines (69 loc) · 1.95 KB
/
excel.vbs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Option Explicit
Const PathName = "D:\Reports\"
Const FileName = "WiP.xlsx"
Const SheetConsumptionRate = "Ðàñõîäíàÿ íîðìà"
Const ForAppending = 8
Private Sub Main()
Dim Tick
Tick = Timer
SaveReport()
Log Tick
End Sub
Sub SaveReport()
Dim FSO, Logging
Set FSO = CreateObject("Scripting.FileSystemObject")
set Logging = FSO.OpenTextFile("wip.log", ForAppending, True)
Logging.WriteLine Now & " INFO: " & "Start"
dim Excel, Source, Dest
dim SheetName
set Excel = CreateObject("Excel.Application")
'Excel.Visible = True
Excel.DisplayAlerts = False
Excel.SheetsInNewWorkbook = 1
SheetName = GetDate(Now)
dim FilePath
FilePath = PathName & Year(Now) & " " & FileName
set Source = Excel.WorkBooks.Open(FilePath)
FilePath = "Z:\" & Year(Now) & "_" & FileName
if ExistFile(FilePath) then
set Dest = Excel.WorkBooks.Open(FilePath)
else
set Dest = Excel.WorkBooks.Add
Dest.SaveAs FilePath
end if
if not SheetExists(Dest, SheetConsumptionRate) then
Source.Sheets(SheetConsumptionRate).Copy Dest.Sheets(1)
end if
if SheetExists(Dest, SheetName) then
Dest.Sheets(SheetName).Delete
end if
Source.Sheets(SheetName).Copy Dest.Sheets(1)
Dest.Sheets(1).Calculate
Dest.Sheets(1).Activate
Dest.Save
Dest.Close
Set Dest = Nothing
Source.Close
set Source = Nothing
Excel.Quit
Set Excel = Nothing
Logging.WriteLine Now & " INFO: " & "Done"
Logging.Close
Set Logging = Nothing
Set FSO = Nothing
End Sub
function GetDate(D)
GetDate = Year(D) & "-" & right("0" & Month(D), 2) & "-" & right("0" & Day(D), 2)
end function
function SheetExists(WorkBook, SheetName)
On Error Resume Next
SheetExists = (LCase(WorkBook.Sheets(SheetName).Name) = LCase(SheetName))
On Error Goto 0
end function
Function ExistFile(FileName)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
ExistFile = FSO.FileExists(FileName)
Set FSO = Nothing
End Function
Main()