Attribute VB_Name = "ImportFiles"
Option Compare Database
Public xlApp As Object
Public wb, fs As Variant
Public PathPar, vpolPar, FilePar, PerPar, ParType, FullPath, ArrInp, ArrOut, NextPer, UpdYr, PerBase, VerPar As String
Public TotAm As Currency
Public dB As Database
Public Inp, Out, Par As Recordset
Public i, j, c, InpBox As Integer
Public FileExist As Boolean

Public Sub StatusBar(Optional msg As Variant)
Dim Temp As Variant

If Not IsMissing(msg) Then
    If msg <> "" Then
        Temp = SysCmd(acSysCmdSetStatus, msg)
    Else
        Temp = SysCmd(acSysCmdClearStatus)
    End If
Else
   Temp = SysCmd(acSysCmdClearStatus)
End If
 
End Sub

Public Sub AdjustExcelFiles()

DoCmd.Hourglass True

PathPar = DLookup("ValText", "Parameters", "[Parameter]= " & "'ImportPath'")
FilePar = DLookup("ValText", "Parameters", "[Parameter]= " & "'PracovName'")
PerPar = DLookup("ValText", "Parameters", "[Parameter]= " & "'Pracov'")
ParType = DLookup("ValText", "Parameters", "[Parameter]= " & "'ExcelFileType'")
vpolPar = DLookup("ValText", "Parameters", "[Parameter]= " & "'VlpolName'")

If Right(PerPar, 2) = "12" Then
    NextPer = Val(Left(PerPar, 4)) + 1 & "01"
Else
    If Val(Right(PerPar, 2)) < 9 Then NextPer = Left(PerPar, 4) & "0" & Val(Right(PerPar, 2)) + 1 Else NextPer = Left(PerPar, 4) & Val(Right(PerPar, 2)) + 1
End If
FullPath = PathPar & "\" & FilePar & NextPer & ParType

ArrOut = Array("KatalogPrac", "DetailAbs", "DetailCum")
ArrInp = Array("01_02KatalogPracUpdQ", "01_10DetailAbsUpdQ", "01_20DetailCumUpdQ")

Set fs = CreateObject("Scripting.FileSystemObject")
Set dB = CurrentDb()
Set Par = dB.OpenRecordset("SELECT Parameter, ValText FROM [Parameters] WHERE Parameter = 'Pracov'", dbOpenDynaset)
c = -1

If Dir(FullPath) = "" Then
    FileExist = False
Else
    If Dir(PathPar & "\" & vpolPar & NextPer & ParType) = "" Then
        c = -2
        FileExist = False
    Else
        FileExist = True
    End If
End If

If FileExist = True Then

    Do Until FileExist = False
        
        'Pokud existuje soubor pracovníci pro nové období, zpracuj importní soubory viz ArrOut výše ve 3 krocích
        For c = 0 To 2
            
            Forms!MainForm.ImportInfo = "Zpracovávám data za období " & NextPer & ", entita " & ArrOut(c) & ", krok " & c * 2 + 1 & "/7 ..."
            Set Out = dB.OpenRecordset(ArrOut(c), dbOpenDynaset)
            
            'Otevření souboru s pracovníky a jeho uzpůsobení struktuře v Access
            Set xlApp = New Excel.Application
            Set wb = xlApp.Workbooks.Open(FullPath)
            
            For i = 1 To 1000
                If xlApp.Cells(1, i).Value = "" Then GoTo SkipFin
            Next i
SkipFin:
           
            xlApp.Cells(1, i).Value = "VstupníParametry"
            For j = 0 To Out.Fields.Count - 1
                xlApp.Cells(j + 2, i).Value = Out(j).Name
            Next j
            
            xlApp.Cells(1, 1).Select
            xlApp.Rows(1).Insert
            xlApp.Cells(1, 1).FormulaR1C1 = "=IFERROR(vlookup(R[1]C[0],R3C" & i & ":R" & Out.Fields.Count + 2 & "C" & i & ",1,false),1)"
            xlApp.Cells(1, 1).Select
            xlApp.Selection.Copy
            xlApp.Range(xlApp.Cells(1, 2), xlApp.Cells(1, i)).PasteSpecial xlPasteFormulas
            xlApp.Range(xlApp.Cells(1, 1), xlApp.Cells(1, i)).Select
            xlApp.Selection.Copy
            xlApp.Range(xlApp.Cells(1, 1), xlApp.Cells(1, i)).PasteSpecial xlPasteValues
            
            For j = i To 1 Step -1
                If xlApp.Cells(1, j).Value = 1 Then xlApp.Columns(j).Delete
            Next j
            
            xlApp.Rows(1).Delete
            If Len(Dir(PathPar & "\" & "Import" & ArrOut(c) & ParType)) > 0 Then Kill PathPar & "\" & "Import" & ArrOut(c) & ParType
            wb.SaveAs PathPar & "\" & "Import" & ArrOut(c) & ParType
            wb.Close
            
            'Aktualizace dat (pouze přidávání)
            Forms!MainForm.ImportInfo = "Nahrávám data za období " & NextPer & ", entita " & ArrOut(c) & ", krok " & c * 2 + 2 & "/7 ..."
            Set Inp = dB.OpenRecordset(ArrInp(c), dbOpenDynaset)
            
            Do Until Inp.EOF
                Out.AddNew
                For i = 0 To Inp.Fields.Count - 1
                    Out(i).Value = Inp(i).Value
                Next i
                Out.Update
                Inp.MoveNext
            Loop
    
            Set wb = xlApp.Workbooks.Open(FullPath)
            wb.Close
            
            Set Inp = Nothing
            Set xlApp = Nothing
            Set wb = Nothing
            
        Next c
        
        'Nakopírování souboru a aktualizace VLPOL za aktuální měsíc
        Forms!MainForm.ImportInfo = "Aktualizuji tabulku VPOL, krok 7/7 ..."
        
        If Len(Dir(PathPar & "\Importvlpol.xlsx")) > 0 Then Kill PathPar & "\Importvlpol.xlsx"
        fs.CopyFile PathPar & "\" & vpolPar & NextPer & ParType, PathPar & "\Importvlpol.xlsx"
        CurrentDb.Execute "INSERT INTO VPOL SELECT * FROM [01_30VPOLupdQ]"
        
        Set Par = dB.OpenRecordset("SELECT Parameter, ValText FROM [Parameters] WHERE Parameter = 'Pracov'", dbOpenDynaset)
        Par.Edit
        Par(1).Value = NextPer
        Par.Update
        
        Set Par = dB.OpenRecordset("SELECT Parameter, ValText FROM [Parameters] WHERE Parameter = 'ReportPeriod'", dbOpenDynaset)
        Par.Edit
        Par(1).Value = NextPer
        Par.Update
        
        If Right(NextPer, 2) = "12" Then
            NextPer = Val(Left(NextPer, 4)) + 1 & "01"
        Else
            If Val(Right(NextPer, 2)) < 9 Then NextPer = Left(NextPer, 4) & "0" & Val(Right(NextPer, 2)) + 1 Else NextPer = Left(NextPer, 4) & Val(Right(NextPer, 2)) + 1
        End If
        FullPath = PathPar & "\" & FilePar & NextPer & ParType
        If Dir(FullPath) = "" Or Dir(PathPar & "\" & vpolPar & NextPer & ParType) = "" Then FileExist = False Else FileExist = True
    
        Forms!MainForm.Refresh
        
    Loop

End If

Set fs = Nothing
Set xlApp = Nothing
Set wb = Nothing
Set dB = Nothing
Set Inp = Nothing
Set Out = Nothing
Set Par = Nothing

DoCmd.Hourglass False
If c = -1 Then
    MsgBox ("Ve složce " & PathPar & " nenalezeny žádné nové aktualizace.")
    Exit Sub
Else
    If c = -2 Then
        MsgBox ("K souboru " & FullPath & " nenalezen soubor " & PathPar & "\" & vpolPar & NextPer & ParType & "." & vbCrLf & "Zpracování není možné.")
        Exit Sub
    End If
End If

'Aktualizace měsíční dovolené
Forms!MainForm.ImportInfo = "Aktualizuji měsíční čerpání dovolené ..."
Adjustment.UpdateMthlyDovce

'Aktualizace systemizace
Adjustment.SystemizaceMonthly

Forms!MainForm.ImportInfo = ""
    
Forms!MainForm.ImportInfo = "Provádím komprimaci aktualizovaných databází ..."
CompactRepairDB ("FNOL_PersonalMaster")
CompactRepairDB ("FNOL_Personal_Cis")
Forms!MainForm.ImportInfo = ""

MsgBox ("Hotovo.")

End Sub

Public Sub OpenXlsBgtInputFile()
Shell "excel.exe" & " " & "C:\FNOL\ON\BgtInputs.xlsx", vbNormalFocus
End Sub

Public Sub ArchiveBgtVersion()
Dim BgtVer As Integer

PathPar = DLookup("ValText", "Parameters", "[Parameter]= " & "'PathBgtInput'")

Set dB = CurrentDb()
Set Out = dB.OpenRecordset("BgtArchiveHeader", dbOpenDynaset)

Out.AddNew
Out(1).Value = Forms!MainForm.VerDescription
Out(2).Value = Now()

Set rstAttachments = Out.Fields("BgtInputFile").Value
rstAttachments.AddNew
rstAttachments.Fields("FileData").LoadFromFile (PathPar & "\BgtInputs.xlsx")
rstAttachments.Update
rstAttachments.Close

BgtVer = Out(0).Value
Out.Update

CurrentDb.Execute "INSERT INTO BgtArchiveRecap SELECT " & BgtVer & " as Ver, BgtIssue, Loc, obd, devpp, pevp, prevp, odprh, odprp, dovceh, neoh, ZakMzda, Presc, PriplSmenn, PriplOst, Prodm, [_OdmOdb] as OdmOdb,[_OdmOst] as OdmOst, Nah, Poh, FondVed, [_FvHodm] as FvHodm, [_FvHodmT] as FvHodmT, [_FvQodm] as FvQodm, [_FvIssOdm] as FvIssOdm, [_FvIssExt] as FvIssExt, [_FvOstOdm] as FvOstOdm, MzdyOst, OON, HrMzda,PriplPr25, PriplPr50, PriplDvPr, PriplTrPr, PriplSv, PriplPsGe, PriplJIP, PriplProst, PriplPr50H, PriplMinMz, PriplVed, PriplNoc, PriplOs, PriplNPZat FROM BgtRecap"
CurrentDb.Execute "INSERT INTO BgtArchiveDetailAbs SELECT " & BgtVer & " as Ver, Loc, oscis, obd, pracv, kateg, pevp, prevp, devpp, tarifUprTD, odprh, odprp, dovceh, neoh, ZakMzda, Presc, PriplSmenn, PriplOst, Prodm, [_OdmHVpol] as OdmHVpol, [_OdmDoplD] as OdmDoplD, [_OdmMim] as OdmMim, [_OdmPrisVyk] as OdmPrisVyk, [_OdmPris] as OdmPris, [_OdmVed] as OdmVed, [_OdmVedOs] as OdmVedOs, [_OdmZast] as OdmZast, [_OdmOdb] as OdmOdb, [_OdmOst] as OdmOst, Nah, [_NahDov] as NahDov, [_NahPN] as NahPN, [_NahOst] as NahOst, Poh, FondVed, [_FvHodm] as FvHodm, [_FvHodmT] as FvHodmT, [_FvQodm] as FvQodm, [_FvIssOdm] as FvIssOdm, [_FvIssExt] as FvIssExt, [_FvOstOdm] as FvOstOdm, MzdyOst, OON, [_OonPP] as OonPP, [_OonPC] as OonPC, [_OonOst] as OonOst, HrMzda, Comment, utv, repre, tyduvs, tyduvi, SocPoj, ZdravPoj, FKSP, NewPar,PriplPr25, PriplPr50, PriplDvPr, PriplTrPr, PriplSv, PriplPsGe, PriplJIP, PriplProst, PriplPr50H, PriplMinMz, PriplVed, PriplNoc, PriplOs, PriplNPZat FROM BgtDetailAbs"

Set Out = Nothing
Set dB = Nothing

CompactRepairDB ("FNOL_Personal_BgtArchive")

End Sub

Public Sub UpdateAnalyzeModul()

PerPar = DLookup("ValText", "Parameters", "[Parameter]= " & "'ReportPeriod'")
PerBase = DLookup("ValText", "Parameters", "[Parameter]= " & "'RepPerMin'")
VerPar = Forms!BgtArchiveHeaderF.Ver
CurrentDb.Execute "DELETE * FROM AnalyzisTemp"
CurrentDb.Execute "DELETE * FROM AnalyzisFin"

'Upload archivu plánu do prvků P0
CurrentDb.Execute "INSERT INTO AnalyzisTemp SELECT Loc, oscis , pracv , kateg , iif(obd=" & "'" & PerPar & "'" & ",pevp,0) as P0_pevp, iif(obd=" & "'" & PerPar & "'" & ",prevp,0) as P0_prevp, devpp as P0_devpp, iif(obd=" & "'" & PerPar & "'" & ",tarifUprTD,0) as P0_tarifUprTD, odprh as P0_odprh, odprp as P0_odprp, " & _
"dovceh as P0_dovceh, neoh as P0_neoh, ZakMzda as P0_ZakMzda, Presc+PriplPr25+PriplPr50 as P0_Presc, PriplSmenn as P0_PriplSmenn, PriplDvPr as P0_PriplDvPr, " & _
"PriplTrPr as P0_PriplTrPr, PriplSv as P0_PriplSv, PriplPsGe as P0_PriplPsGe, PriplJIP as P0_PriplJIP, PriplProst as P0_PriplProst, PriplPr50H as P0_PriplPr50H, PriplMinMz as P0_PriplMinMz, " & _
"PriplVed as P0_PriplVed, PriplNoc as P0_PriplNoc, PriplOs as P0_PriplOs, PriplNPZat as P0_PriplNPZat, PriplOst as P0_PriplOst, Prodm as P0_Prodm, OdmHVpol as P0_OdmHVpol, OdmDoplD as P0_OdmDoplD, " & _
"OdmMim as P0_OdmMim, OdmPrisVyk as P0_OdmPrisVyk, OdmPris as P0_OdmPris, OdmVed as P0_OdmVed, OdmVedOs as P0_OdmVedOs, OdmZast as P0_OdmZast, OdmOdb as P0_OdmOdb, OdmOst as P0_OdmOst, Nah as P0_Nah, " & _
"NahDov as P0_NahDov, NahPN as P0_NahPN, NahOst as P0_NahOst, Poh as P0_Poh, FondVed as P0_FondVed, FvHodm as P0_FvHodm, FvHodmT as P0_FvHodmT, FvQodm as P0_FvQodm, FvOstOdm as P0_FvOstOdm, " & _
"MzdyOst as P0_MzdyOst, OON as P0_OON, OonPP as P0_OonPP, OonPC as P0_OonPC, OonOst as P0_OonOst, HrMzda as P0_HrMzda From BgtArchiveDetailAbs " & _
"WHERE Ver = " & VerPar & " AND (obd <= '" & PerPar & "' And obd >= '" & PerBase & "')"

'Upload hodnot sklutečnosti do prvků P1
CurrentDb.Execute "INSERT INTO AnalyzisTemp SELECT Loc, oscis , pracv , kateg , pevp as P1_pevp, prevp as P1_prevp, devpp as P1_devpp, tarifUprTD as P1_tarifUprTD, odprh as P1_odprh, odprp as P1_odprp, " & _
"dovceh as P1_dovceh, neoh as P1_neoh, ZakMzda as P1_ZakMzda, Presc as P1_Presc, PriplSmenn as P1_PriplSmenn, PriplDvPr as P1_PriplDvPr, " & _
"PriplTrPr as P1_PriplTrPr, PriplSv as P1_PriplSv, PriplPsGe as P1_PriplPsGe, PriplJIP as P1_PriplJIP, PriplProst as P1_PriplProst, PriplPr50H as P1_PriplPr50H, PriplMinMz as P1_PriplMinMz, " & _
"PriplVed as P1_PriplVed, PriplNoc as P1_PriplNoc, PriplOs as P1_PriplOs, PriplNPZat as P1_PriplNPZat, PriplOst as P1_PriplOst, Prodm as P1_Prodm, OdmHVpol as P1_OdmHVpol, OdmDoplD as P1_OdmDoplD, " & _
"OdmMim as P1_OdmMim, OdmPrisVyk as P1_OdmPrisVyk, OdmPris as P1_OdmPris, OdmVed as P1_OdmVed, OdmVedOs as P1_OdmVedOs, OdmZast as P1_OdmZast, OdmOdb as P1_OdmOdb, OdmOst as P1_OdmOst, Nah as P1_Nah, " & _
"NahDov as P1_NahDov, NahPN as P1_NahPN, NahOst as P1_NahOst, Poh as P1_Poh, FondVed as P1_FondVed, FvHodm as P1_FvHodm, FvHodmT as P1_FvHodmT, FvQodm as P1_FvQodm, FvOstOdm as P1_FvOstOdm, " & _
"MzdyOst as P1_MzdyOst, OON as P1_OON, OonPP as P1_OonPP, OonPC as P1_OonPC, OonOst as P1_OonOst, HrMzda as P1_HrMzda From 09_02ActForAnalyzisQ"

'Sehrání obou verzí do finálního souboru
CurrentDb.Execute "INSERT INTO AnalyzisFin SELECT Loc, oscis, pracv, kateg, P0_pevp, P0_prevp, P0_devpp, P0_tarifUprTD, P0_odprh, P0_odprp, P0_dovceh, P0_neoh, P0_ZakMzda, P0_Presc, P0_PriplSmenn, " & _
"P0_PriplDvPr, P0_PriplTrPr, P0_PriplSv, P0_PriplPsGe, P0_PriplJIP, P0_PriplProst, P0_PriplPr50H, P0_PriplMinMz, P0_PriplVed, P0_PriplNoc, P0_PriplOs, P0_PriplNPZat, P0_PriplOst," & _
"P0_Prodm, P0_OdmHVpol, P0_OdmDoplD, P0_OdmMim, P0_OdmPrisVyk, P0_OdmPris, P0_OdmVed, P0_OdmVedOs, P0_OdmZast, P0_OdmOdb, P0_OdmOst, P0_Nah, P0_NahDov, P0_NahPN, P0_NahOst, P0_Poh, " & _
"P0_FondVed, P0_FvHodm, P0_FvHodmT, P0_FvQodm, P0_FvOstOdm, P0_MzdyOst, P0_OON, P0_OonPP, P0_OonPC, P0_OonOst, P0_HrMzda, P1_pevp, P1_prevp, P1_devpp, P1_tarifUprTD, P1_odprh, P1_odprp, P1_dovceh, P1_neoh, P1_ZakMzda, P1_Presc, " & _
"P1_PriplSmenn, P1_PriplDvPr, P1_PriplTrPr, P1_PriplSv, P1_PriplPsGe, P1_PriplJIP, P1_PriplProst, P1_PriplPr50H, P1_PriplMinMz, P1_PriplVed, P1_PriplNoc, P1_PriplOs, P1_PriplNPZat, P1_PriplOst, " & _
"P1_Prodm, P1_OdmHVpol, P1_OdmDoplD, P1_OdmMim, P1_OdmPrisVyk, P1_OdmPris, P1_OdmVed, P1_OdmVedOs, P1_OdmZast, P1_OdmOdb, P1_OdmOst, P1_Nah, P1_NahDov, P1_NahPN, " & _
"P1_NahOst, P1_Poh, P1_FondVed, P1_FvHodm, P1_FvHodmT, P1_FvQodm, P1_FvOstOdm, P1_MzdyOst, P1_OON, P1_OonPP, P1_OonPC, P1_OonOst, P1_HrMzda, KalDnyPer FROM 09_10TempToFinAnalyzisQ"

'Výmaz přechodného souboru, odstranění nulových hrubých mezd ve finálním souboru a komprimacer databáze
CurrentDb.Execute "DELETE * FROM AnalyzisTemp"
CurrentDb.Execute "DELETE * FROM 09_11ZeroRowsFinForDeleteQ"
CompactRepairDB ("FNOL_Personal_BgtAnalyze")

End Sub

Public Sub SystemizaceImport()

If Dir(DLookup("ValText", "Parameters", "[Parameter]= " & "'PathBgtInput'") & "\Systemizace.xls") = "" Then
    MsgBox ("Soubor " & DLookup("ValText", "Parameters", "[Parameter]= " & "'PathBgtInput'") & "\Systemizace.xls neexistuje.")
    Exit Sub
End If

PerPar = DLookup("ValText", "Parameters", "[Parameter]= " & "'ReportPeriod'")

InpBox = MsgBox("Původní systemizace bude ukončena k období " & PerPar & "." & vbCrLf & "Bude nahrána nová systemizace.", vbYesNo)
If InpBox = 7 Then Exit Sub

Set dB = CurrentDb()
Set Out = dB.OpenRecordset("SELECT obd FROM Systemizace WHERE obd = '999912'", dbOpenDynaset)
Do Until Out.EOF
    Out.Edit
    Out(0).Value = PerPar
    Out.Update
    Out.MoveNext
Loop

Set xlApp = New Excel.Application
Set wb = xlApp.Workbooks.Open(DLookup("ValText", "Parameters", "[Parameter]= " & "'PathBgtInput'") & "\Systemizace.xls")

Set Out = dB.OpenRecordset("Systemizace", dbOpenDynaset)

For i = 4 To 1000 'Zjištění počtu řádků
    If wb.Sheets("Systemizace").Cells(i, 1).Value = "" Then GoTo SkipI
Next i

SkipI:
i = i - 1 'Počet řádků

For j = 4 To 1000
    If wb.Sheets("Systemizace").Cells(1, j).Value = "CELKEM" Then
        TotAm = wb.Sheets("Systemizace").Cells(i + 1, j).Value
        GoTo SkipJ
    End If
    
    If wb.Sheets("Systemizace").Cells(1, j).Value = "" Then GoTo SkipNextJ
    
    For c = 4 To i
        If wb.Sheets("Systemizace").Cells(c, j).Value = "" Then GoTo SkipNextC
        Out.AddNew
        Out(0).Value = "999912"
        If wb.Sheets("Systemizace").Cells(c, 2).Value = "" Then Out(1).Value = wb.Sheets("Systemizace").Cells(c, 1).Value & "00" Else Out(1).Value = wb.Sheets("Systemizace").Cells(c, 1).Value & wb.Sheets("Systemizace").Cells(c, 2).Value
        Out(2).Value = wb.Sheets("Systemizace").Cells(1, j).Value
        Out(3).Value = wb.Sheets("Systemizace").Cells(c, j).Value
        Out.Update
SkipNextC:
    Next c
    
SkipNextJ:
Next j

SkipJ:

wb.Close

Set xlApp = Nothing
Set wb = Nothing
Set dB = Nothing
Set Out = Nothing

If CLng(DSum("volume", "Systemizace", "[obd]=" & "'999912'")) <> CLng(TotAm) Then
    MsgBox ("Zpracováno, ale excel obsahuje celkový počet " & CLng(TotAm) & ", naimportováno bylo " & CLng(DSum("volume", "Systemizace", "[obd]=" & "'999912'")) & ".")
Else
    MsgBox ("Zpracováno bez chyb.")
End If

End Sub