127
Sleep 15000
KillIE
' Выбор файлов RAR
filename = Dir(pathRAR & "*.rar")
' Разархивирование файлов RAR
While filename <> ""
CreateObject("WScript.Shell").Run """C:\Program
Files\WinRAR\WinRAR.exe"" E -o+ """ & pathRAR & filename & """
""C:\Users\micro\Desktop\ActualUS\EXCEL\"" ", 1, True
filename = Dir
Wend
' Отключение обновления экрана
'Application.ScreenUpdating = False
' Установка первоначальной даты
reportDate = "06.05.2020"
' Цикл на 1000 дней
For day = 1 To 1000
' Преобразование даты в строку
pathDate = Format(reportDate, "yyyymmdd")
' Выбор книги
wb = Dir(path & "Данные_УС_" & pathDate & "*")
128
' Проверка, есть ли книги
If wb <> "" Then
' Открыть книгу
Workbooks.Open path & wb
Set ws = Workbooks(wb).Worksheets(1)
' Удаление лишних интервалов в документе
ws.Range("A1:AA4").Delete
ws.Range("C1:C100000").Delete
ws.Range("E1:AA100000").Delete
' Пока значение не пустое, проставляется дата документа
c = 1
While ws.Cells(c, 2) <> ""
ws.Cells(c, 4) = reportDate
c = c + 1
Wend
' Сохранение активной книги в формате csv и закрытие
ActiveWorkbook.SaveAs pathCSV & "us_upload.csv", xlCSV, , , , , , , , , ,
True
ActiveWorkbook.Close False
' Выполнить файл .bat
CreateObject("WScript.Shell").Run
"C:\Users\micro\Desktop\ActualUS\MAIN\tmp_actual_us.bat", 1, True
' Удалить файл в формате csv
Kill pathCSV & "us_upload.csv"
129
' Открыть подключение к БД
cn.Open
' Удалить строки, если статус не "Активный" или ID пустой
cn.Execute "DELETE FROM c##avg.tmp_actual_us a WHERE a.status <>
'Активный' OR a.id IS NULL"
' Удалить дубли из c##avg.tmp_actual_us при наличии
cn.Execute "DELETE FROM c##avg.tmp_actual_us" & vbNewLine & _
"WHERE rowid IN (" & vbNewLine & _
"SELECT rid FROM ( SELECT t1.rowid as rid, ROW_NUMBER()
OVER (PARTITION BY id ORDER BY id) rn" & vbNewLine & _
"FROM c##avg.tmp_actual_us t1" & vbNewLine & _
"WHERE id IS NOT NULL ) WHERE rn>1)"
' Поставить конечную дату по недействующим УС
cn.Execute "UPDATE c##avg.actual_us s2 SET enddate = (" &
vbNewLine & _
"SELECT MAX(repdate)-1 FROM c##avg.tmp_actual_us)" &
vbNewLine & _
"WHERE enddate = to_date('01.01.2100', 'dd.mm.yyyy')" &
vbNewLine & _
"AND NOT EXISTS (SELECT 1 FROM c##avg.tmp_actual_us s
WHERE s2.id = s.id)"
' Слияние c##avg.actual_us с c##avg.tmp_actual_us. Если совпадения, то
проставить дату 01.01.2100 для недействующих УС,
' если нет совпадений, вставить несовпадающие строки в
c##avg.tmp_actual_us
cn.Execute "MERGE INTO actual_us au" & vbNewLine & _
130
"USING (SELECT ID, TYPE, repdate FROM tmp_actual_us) tau"
& vbNewLine & _
"ON (au.id = tau.id AND au.enddate > tau.repdate)" & vbNewLine
& _
"WHEN NOT MATCHED THEN" & vbNewLine & _
" INSERT (ID, TYPE, startdate, enddate)" & vbNewLine & _
" VALUES (tau.id, tau.type, tau.repdate-1,
to_date('01.01.2100','dd.mm.yyyy'))"
' Закрыть подключение к БД
cn.Close
End If
' Прибавить к дате 1 день
reportDate = DateAdd("d", 1, reportDate)
Next
'MsgBox ("Complete")
' Включение обновления экрана
'Application.ScreenUpdating = True
End Sub
'Функция, останавливающая все процессы Microsoft Internet Explorer
Sub KillIE()
Dim Process As Object
131
For Each Process In GetObject("winmgmts:").ExecQuery("Select * from
Win32_Process")
If Process.Caption Like "iexplore*" Then
On Error Resume Next
Process.Terminate
End If
Next
End Sub
'Функция, отвечающая за ожидание прогрузки браузера
Private Sub WaitIE(myInternetExplorer As SHDocVw.InternetExplorer)
2. Модуль запуска: основной ( файл actualus.vbs):
with createobject("Excel.Application")
.run "'C:\Users\micro\Desktop\ActualUS\MAIN\actualUS.xlsm'!actualus"
.quit
end with
3. Модуль запуска: дополнительный (файл tmp_actual_us.bat):
sqlldr 'C##AVG/ASDqwe@dbank'
C:\Users\micro\Desktop\ActualUS\LDR\us_loader.ldr
4. Модуль обработки (файл us_loader.ldr):
options (direct=true, rows=1000)
unrecoverable
LOAD DATA
CHARACTERSET CL8MSWIN1251
INFILE 'C:\Users\micro\Desktop\ActualUS\CSV\us_upload.csv'
BADFILE 'MainBad.bad'
truncate
INTO TABLE c##avg.tmp_actual_us
FIELDS TERMINATED BY ';' trailing nullcols
132
(
id ,
type ,
status ,
repdate "to_date(:repdate,'DD.MM.YYYY')"
)
