const xlWorkbookNormal = -4143
const xlOpenXMLWorkbookMacroEnabled = 52

const msoAutomationSecurityForceDisable = 3

const xlDisabled = 0

private function CreateExcelApplication
  set CreateExcelApplication = CreateObject("Excel.Application")
  CreateExcelApplication.AutomationSecurity = msoAutomationSecurityForceDisable
  CreateExcelApplication.ScreenUpdating = False
  CreateExcelApplication.UserControl = False
  CreateExcelApplication.Interactive = False
  CreateExcelApplication.DisplayAlerts = False
  CreateExcelApplication.EnableCancelKey = xlDisabled
  CreateExcelApplication.AlertBeforeOverwriting = False
  CreateExcelApplication.AskToUpdateLinks = False
end function

private function GetExcelFileFormat(FileName)
  set LFileSystem = CreateObject("Scripting.FileSystemObject")

  set LTempStream = LFileSystem.GetFile(FileName).OpenAsTextStream(1, 0)
  LSignature = LTempStream.Read(2)
  LTempStream.Close

  if LSignature = "PK" then
    GetExcelFileFormat = xlOpenXMLWorkbookMacroEnabled
  else
    GetExcelFileFormat = xlWorkbookNormal
  end if
end function

private function GetExcelFileExtensionByFormat(FileName)
  if GetExcelFileFormat(FileName) = xlOpenXMLWorkbookMacroEnabled then
    GetExcelFileExtensionByFormat = ".XLSM"
  else
    GetExcelFileExtensionByFormat = ".XLS"
  end if
end function

sub ExportTemplate
  FileName = GetParamValue("FileName")

  Query.SQL.Text = _
    "select BXLS from V_BLRPFRMTEMPLATES" & vbNewLine &_
    " where NVERSION = :VERSION" & vbNewLine &_
    "   and NRN = :NRN" & vbNewLine &_
    "   and dbms_lob.getlength(BXLS) > 0"
  Query.ParamByName("NRN").Value = DOCUMENT
  Query.ParamByName("VERSION").Value = VERSION

  Query.Open
  if Query.Eof then
    MsgBox "Не найден шаблон выбранного трафарета.", vbSystemModal or vbInformation, "Выгрузка файла трафарета"
  else
    Query.FieldByName("BXLS").SaveToFile FileName
    MsgBox "Файл шаблона выбранного трафарета успешно выгружен.", vbSystemModal or vbInformation, "Выгрузка файла трафарета"
  end if

  Query.Close
end sub

sub ImportTemplate
  FileName = GetParamValue("FileName")

  StoredProc.StoredProcName = "P_BLRPFRMTEMPLATES_BASE_LXLS"
  StoredProc.ParamByName("nRN").Value = DOCUMENT
  StoredProc.ParamByName("nXLS_FORMAT").Value = GetExcelFileFormat(FileName)
  StoredProc.ParamByName("bXLS").LoadFromFile FileName, ftOraBlob
  StoredProc.ExecProc

  MsgBox "Файл шаблона выбранного трафарета успешно загружен.", vbSystemModal or vbInformation, "Загрузка файла трафарета"
end sub

private sub ConvertOldExcel(ExcelApplication, InputFileName, OutputFileName)
  set LBook = ExcelApplication.Workbooks.Open(InputFileName)
  LBook.SaveAs OutputFileName, xlOpenXMLWorkbookMacroEnabled
  LBook.Close False
  set LBook = Nothing
end sub

private function TryConvertOldExcel(ExcelApplication, InputFileName, OutputFileName, ByRef ErrorMessage)
  ErrorMessage = ""
  On Error Resume Next
    ConvertOldExcel ExcelApplication, InputFileName, OutputFileName

    TryConvertOldExcel = Err.Number = 0

    if Err.Number <> 0 then
      ErrorMessage = Err.Description & " (" & Err.Number & ")"
      Err.Clear
    end if
  On Error Goto 0
end function

private function CorrectFileName(FileName)
  Dim Codes
  FileName = Replace(FileName, "*", ".")
  FileName = Replace(FileName, "+", ".")
  FileName = Replace(FileName, "?", ".")
  FileName = Replace(FileName, "\", ".")
  FileName = Replace(FileName, "/", ".")
  FileName = Replace(FileName, """", "'")
  FileName = Replace(FileName, "<", "(")
  FileName = Replace(FileName, ">", ")")
  FileName = Replace(FileName, "|", ".")
  FileName = Replace(FileName, ":", ".")
  FileName = Replace(FileName, Chr(10), " ")
  FileName = Replace(FileName, Chr(13), " ")
  FileName = Replace(FileName, "  ", " ")
  if Len(FileName) > 140 then
    Codes = 0
    for I = 135 to Len(FileName)
      Codes = (Codes + Asc(Mid(FileName, I, 1))) mod 65536
    next
    Codes = Hex(Codes)
    while Len(Codes) < 4
      Codes = "0" & Codes
    wend
    CorrectFileName = Left(FileName, 134) & Codes
  else
    CorrectFileName = FileName
  end if
end function

private sub InternalExportTemplates(FileSystem, AppProvider, ExcelApplication, Folder, _
  DataFieldName, FileNamePrefix, FileNameParts)

  Query.Open
  while not Query.Eof
    LInFileName = AppProvider.CreateTempFileName("XLS")
    Query.FieldByName(DataFieldName).SaveToFile LInFileName

    LActualExtension = GetExcelFileExtensionByFormat(LInFileName)

    LOutFileName = FileNamePrefix
    for each LName in FileNameParts
      LOutFileName = LOutFileName & Query.FieldByName(LName).Value & " - "
    next
    LOutFileName = Left(LOutFileName, Len(LOutFileName) - Len(" - "))
    LOutFileName = CorrectFileName(LOutFileName)
    LOutFileName = LOutFileName & LActualExtension
    LOutFileName = FileSystem.BuildPath(Folder, LOutFileName)

    AppProvider.DebugString Query.FieldByName("NRN").Value & " - " & LOutFileName

    if FileSystem.FileExists(LOutFileName) then
      FileSystem.DeleteFile LOutFileName, True
    end if
    FileSystem.MoveFile LInFileName, LOutFileName

    Query.Next
  wend
  Query.Close
end sub

private sub InternalConvertOldTemplates(FileSystem, AppProvider, ExcelApplication, ByRef ErrorMessages, ByRef Converted, ByRef Broken, ByRef Skiped)
  set LList = CreateObject("Scripting.Dictionary")
  set LBrokenList = CreateObject("Scripting.Dictionary")
  Converted = 0
  Broken = 0
  Skiped = 0

  Query.SQL.Text = _
    "select count(RN) RN from BLRPFRMTEMPLATES" & vbNewLine &_
    " where XLS_FORMAT = 52" & vbNewLine &_
    "   and dbms_lob.getlength(XLS) > 0"
  Query.Open
  Skiped = Query.FieldByName("RN").Value

  Query.SQL.Text = _
    "select RN from BLRPFRMTEMPLATES" & vbNewLine &_
    " where XLS_FORMAT = -4143" & vbNewLine &_
    "   and dbms_lob.getlength(XLS) > 0"
  Query.Open
  while not Query.Eof
    LList.Add Query.FieldByName("RN").Value, 1
    Query.Next
  wend
  Query.Close

  for each LRN in LList.Keys
    LInFileName = AppProvider.CreateTempFileName("XLS")
    LOutFileName = AppProvider.CreateTempFileName("XLSM")

    Query.SQL.Text = "select XLS from BLRPFRMTEMPLATES where RN = " & LRN
    Query.Open
    Query.FieldByName("XLS").SaveToFile LInFileName
    Query.Close

    if not TryConvertOldExcel(ExcelApplication, LInFileName, LOutFileName, LErrorMessage) then
      AppProvider.DebugString LRN & " - " & LErrorMessage
      LBrokenList.Add LRN, LErrorMessage
      Broken = Broken + 1
    else
      AppProvider.DebugString LRN & " - converted successfully"
      Converted = Converted + 1

      StoredProc.StoredProcName = "P_BLRPFRMTEMPLATES_BASE_LXLS"
      StoredProc.ParamByName("nXLS_FORMAT").Value = xlOpenXMLWorkbookMacroEnabled
      StoredProc.ParamByName("nRN").Value = LRN
      StoredProc.ParamByName("bXLS").LoadFromFile LOutFileName, ftOraBlob
      StoredProc.ExecProc

      AppProvider.DebugString LRN & " successful updated with  " & LOutFileName
    end if

    FileSystem.DeleteFile LInFileName
    FileSystem.DeleteFile LOutFileName

  next

  ErrorMessages = ""
  if LBrokenList.Count > 0 then
    LIDs = LBrokenList.Keys
    for I = 0 to LBrokenList.Count - 1
      Query.SQL.Text = _
        "select T.SNAME, E.SCODE, to_char(E.DBEGDATE, 'dd.mm.yyyy') DBEGDATE" & vbNewLine &_
        "  from V_BLRPFRMTEMPLATES T" & vbNewLine &_
        " inner join V_BLREPFORMED E on E.NRN = T.NPRN" & vbNewLine &_
        " where T.NRN = :RN"
      Query.ParamByName("RN").Value = LIDs(I)
      Query.Open

      ErrorMessages = ErrorMessages & "  Форма " & Query.FieldByName("SCODE").Value &_
        " от " & Query.FieldByName("DBEGDATE").Value &_
        ", трафарет " & Query.FieldByName("NAME").Value &_
        " - " & LBrokenList.Item(LIDs(I)) & vbNewLine
    next
  end if
end sub

private sub InternalConvertOldValueHistory(FileSystem, AppProvider, ExcelApplication, ByRef ErrorMessages, ByRef Converted, ByRef Broken, ByRef Skiped)
  set LList = CreateObject("Scripting.Dictionary")
  set LBrokenList = CreateObject("Scripting.Dictionary")
  set LConvertedList = CreateObject("Scripting.Dictionary")
  Converted = 0
  Broken = 0
  Skiped = 0

  Query.SQL.Text = _
    "select NRN from V_BLSUBREPORTSHIST" & vbNewLine &_
    " where dbms_lob.getlength(BDATA) > 0 and nXLS_FORMAT = " & xlWorkbookNormal
  Query.Open
  while not Query.Eof
    LList.Add Query.FieldByName("NRN").Value, 1
    Query.Next
  wend
  Query.Close

  for each LRN in LList.Keys
    LInFileName = AppProvider.CreateTempFileName("XLS")
    LOutFileName = AppProvider.CreateTempFileName("XLSM")

    Query.SQL.Text = "select BDATA from V_BLSUBREPORTSHIST where NRN = " & LRN
    Query.Open
    Query.FieldByName("BDATA").SaveToFile LInFileName
    Query.Close

    if GetExcelFileFormat(LInFileName) = xlWorkbookNormal then
      if not TryConvertOldExcel(ExcelApplication, LInFileName, LOutFileName, LErrorMessage) then
        AppProvider.DebugString LRN & " - " & LErrorMessage
        LBrokenList.Add LRN, LErrorMessage
        Broken = Broken + 1
      else
        AppProvider.DebugString LRN & " - converted successfully"
        LConvertedList.Add LRN, LOutFileName
        Converted = Converted + 1
      end if
    else
      Skiped = Skiped + 1
    end if

    FileSystem.DeleteFile LInFileName
    'FileSystem.DeleteFile LOutFileName

  next

  if LConvertedList.Count > 0 then
    Query.SQL.Text = "select gen_ident ident from dual"
    Query.Open
    LIdent = Query.FieldByName("ident").Value

    StoredProc.StoredProcName = "P_FILE_BUFFER_INSERT"
    StoredProc.ParamByName("nIDENT").Value = LIdent

    LIDs = LConvertedList.Keys
    for I = 0 to LConvertedList.Count - 1
      LOutFileName = LConvertedList.Item(LIDs(I))

      StoredProc.ParamByName("cFILENAME").Value = LIDs(I)
      StoredProc.ParamByName("bLOBDATA").LoadFromFile LOutFileName, ftOraBlob
      StoredProc.ExecProc

      AppProvider.DebugString LIDs(I) & " successful loaded from " & LOutFileName

      FileSystem.DeleteFile LOutFileName
    next

    Query.SQL.Text = _
      "declare" & vbNewLine &_
      "  nIDENT number;" & vbNewLine &_
      "begin" & vbNewLine &_
      "  nIDENT := :IDENT;" & vbNewLine &_
      "  begin" & vbNewLine &_
      "    execute immediate 'alter table BLSUBREPORTSHIST disable all triggers';" & vbNewLine &_
      "    for C in (select FILENAME, BDATA from FILE_BUFFER where IDENT=nIDENT) loop" & vbNewLine &_
      "      update BLSUBREPORTSHIST set DATA = C.BDATA, XLS_FORMAT = 52 where RN = to_number(C.FILENAME);" & vbNewLine &_
      "    end loop;" & vbNewLine &_
      "    P_FILE_BUFFER_CLEAR(nIDENT);" & vbNewLine &_
      "    execute immediate 'alter table BLSUBREPORTSHIST enable all triggers';" & vbNewLine &_
      "  exception" & vbNewLine &_
      "    when OTHERS then" & vbNewLine &_
      "      execute immediate 'alter table BLSUBREPORTSHIST enable all triggers';" & vbNewLine &_
      "      raise;" & vbNewLine &_
      "  end;" & vbNewLine &_
      "end;"

    Query.ParamByName("IDENT").Value = LIdent
    Query.Execute

    AppProvider.DebugString "Values history updated."

  end if

  ErrorMessages = ""
  if LBrokenList.Count > 0 then
    LIDs = LBrokenList.Keys
    for I = 0 to LBrokenList.Count - 1
      Query.SQL.Text = _
        "select T.SFORM_CODE, to_char(T.DBDATE, 'dd.mm.yyyy') DBDATE, T.SAGENT_CODE, H.SAUTHID, to_char(H.DREPORT_DATE, 'dd.mm.yyyy') DREPORT_DATE" & vbNewLine &_
        "  from V_BLSUBREPORTSHIST H inner join V_BLSUBREPORTS T" & vbNewLine &_
        "    on H.NPRN = T.NRN" & vbNewLine &_
        " where H.NRN = :RN"
      Query.ParamByName("RN").Value = LIDs(I)
      Query.Open

      ErrorMessages = ErrorMessages & "  Пользователя " & Query.FieldByName("SAUTHID").Value &_
      " от " & Query.FieldByName("DREPORT_DATE").Value &_
      " Отчета с формой " & Query.FieldByName("SFORM_CODE").Value &_
      " от " & Query.FieldByName("DBDATE").Value &_
      ", контрагента " & Query.FieldByName("SAGENT_CODE").Value &_
      " - " & LBrokenList.Item(LIDs(I)) & vbNewLine

      Query.Close
    next
  end if
end sub

private sub InternalConvertOldUserReportTemplates(FileSystem, AppProvider, ExcelApplication, ByRef ErrorMessages, ByRef Converted, ByRef Broken, ByRef Skiped)
  set LList = CreateObject("Scripting.Dictionary")
  set LBrokenList = CreateObject("Scripting.Dictionary")
  set LConvertedList = CreateObject("Scripting.Dictionary")
  set LFileNames = CreateObject("Scripting.Dictionary")
  Converted = 0
  Broken = 0
  Skiped = 0

  Query.SQL.Text = _
    "select NRN" & vbNewLine &_
    "  from V_USERREPORTS" & vbNewLine &_
    " where NREPORT_TYPE = 1" & vbNewLine &_
    "   and dbms_lob.getlength(BTEMPLATE_DATA) > 0"
  Query.Open
  while not Query.Eof
    LList.Add Query.FieldByName("NRN").Value, 1
    Query.Next
  wend
  Query.Close

  for each LRN in LList.Keys

    LInFileName = AppProvider.CreateTempFileName("XLS")
    LOutFileName = AppProvider.CreateTempFileName("XLSM")

    Query.SQL.Text = "select SCODE, SFILE_NAME, BTEMPLATE_DATA from V_USERREPORTS where NRN = " & LRN
    Query.Open
    Query.FieldByName("BTEMPLATE_DATA").SaveToFile LInFileName

    if GetExcelFileFormat(LInFileName) = xlWorkbookNormal then
      if not TryConvertOldExcel(ExcelApplication, LInFileName, LOutFileName, LErrorMessage) then
        AppProvider.DebugString LRN & " - " & LErrorMessage
        LBrokenList.Add LRN, LErrorMessage
        Broken = Broken + 1
      else
        AppProvider.DebugString LRN & " - converted successfully"
        LNewFileName = FileSystem.GetBaseName(Query.FieldByName("SFILE_NAME").Value) & ".XLSM"
        LFileNames.Add LRN, LNewFileName
        LConvertedList.Add LRN, LOutFileName
        Converted = Converted + 1
      end if
    else
      Skiped = Skiped + 1
    end if

    Query.Close

    FileSystem.DeleteFile LInFileName
    'FileSystem.DeleteFile LOutFileName

  next

  if LConvertedList.Count > 0 then
    LIDs = LConvertedList.Keys
    for I = 0 to LConvertedList.Count - 1
      LOutFileName = LConvertedList.Item(LIDs(I))
      LNewFileName = LFileNames.Item(LIDs(I))

      Query.SQL.Text =_
        "update USERREPORTS" & vbNewLine &_
        "   set TEMPLATE_DATA = :TEMPLATE_DATA, FILE_NAME = :FILE_NAME, CRC = :CRC" & vbNewLine &_
        " where RN = :RN"
      Query.ParamByName("RN").Value = LIDs(I)
      Query.ParamByName("FILE_NAME").Value = LNewFileName
      Query.ParamByName("CRC").Value = AppProvider.MD5(LOutFileName)
      Query.ParamByName("TEMPLATE_DATA").LoadFromFile LOutFileName, ftOraBlob
      Query.Execute

      AppProvider.DebugString LIDs(I) & " successful updated with " & LOutFileName

      FileSystem.DeleteFile LOutFileName
    next
  end if

  ErrorMessages = ""
  if LBrokenList.Count > 0 then
    LIDs = LBrokenList.Keys
    for I = 0 to LBrokenList.Count - 1
      Query.SQL.Text = _
        "select SCODE, SFILE_NAME" & vbNewLine &_
        "  from V_USERREPORTS" & vbNewLine &_
        " where NRN = :RN"

      Query.ParamByName("RN").Value = LIDs(I)
      Query.Open

      ErrorMessages = ErrorMessages & "  Мнемокод " & Query.FieldByName("SCODE").Value &_
      ", файл " & Query.FieldByName("SFILE_NAME").Value &_
      " - " & LBrokenList.Item(LIDs(I)) & vbNewLine

      Query.Close
    next
  end if
end sub

sub ConvertOldTemplates
  ConvertTemplates = GetParamValue("CONVERT_TEMPLATES") = 1
  ConvertValueHistory = GetParamValue("CONVERT_VALUE_HISTORY") = 1
  ConvertUserReportTemplates = GetParamValue("CONVERT_USERREPORT_TEMPLATES") = 1

  if not (ConvertTemplates or ConvertValueHistory or ConvertUserReportTemplates) then
    MsgBox "Не выбран ни один тип конвертации.", vbSystemModal or vbCritical, "Конвертация старых трафаретов"
    exit sub
  end if

  set LFileSystem = CreateObject("Scripting.FileSystemObject")
  set LAppProvider = CreateObject("ParusAppServerProvider.Provider")
  set LExcelApplication = CreateExcelApplication

  LErrorMessages = ""
  LSuccessMessages = ""

  if ConvertTemplates then
    InternalConvertOldTemplates LFileSystem, LAppProvider, LExcelApplication, LErrors, LConverted, LBroken, LSkiped

    LSuccessMessages = LSuccessMessages & vbNewLine &_
      "Конвертация трафаретов:" & vbNewLine &_
      "  Пропущено (уже в новом формате): " & LSkiped & vbNewLine &_
      "  Успешно: " & LConverted & vbNewLine &_
      "  Неуспешно: " & LBroken & vbNewLine

    if Len(LErrors) > 0 then
      LErrorMessages = LErrorMessages & vbNewLine &_
        "Ошибки при конвертации трафаретов:" & vbNewLine & LErrors & vbNewLine
    end if
  end if

  if ConvertValueHistory then
    InternalConvertOldValueHistory LFileSystem, LAppProvider, LExcelApplication, LErrors, LConverted, LBroken, LSkiped

    LSuccessMessages = LSuccessMessages & vbNewLine &_
      "Конвертация истории значений:" & vbNewLine &_
      "  Пропущено (уже в новом формате): " & LSkiped & vbNewLine &_
      "  Успешно: " & LConverted & vbNewLine &_
      "  Неуспешно: " & LBroken & vbNewLine

    if Len(LErrors) > 0 then
      LErrorMessages = LErrorMessages & vbNewLine &_
        "Ошибки при конвертации истории значений:" & vbNewLine & LErrors & vbNewLine
    end if
  end if

  if ConvertUserReportTemplates then
    InternalConvertOldUserReportTemplates LFileSystem, LAppProvider, LExcelApplication, LErrors, LConverted, LBroken, LSkiped

    LSuccessMessages = LSuccessMessages & vbNewLine &_
      "Конвертация шаблонов пользовательских отчетов:" & vbNewLine &_
      "  Пропущено (уже в новом формате): " & LSkiped & vbNewLine &_
      "  Успешно: " & LConverted & vbNewLine &_
      "  Неуспешно: " & LBroken & vbNewLine

    if Len(LErrors) > 0 then
      LErrorMessages = LErrorMessages & vbNewLine &_
        "Ошибки при конвертации шаблонов пользовательских отчетов:" & vbNewLine & LErrors & vbNewLine
    end if
  end if

  LExcelApplication.Quit
  set LExcelApplication = Nothing

  LAppProvider.DebugString "Статистика конвертации:" & vbNewLine & LSuccessMessages
  if Len(LErrorMessages) > 0 then
    LSuccessMessages = LSuccessMessages & vbNewLine &_
      "Лог с ошибками откроется после данного сообщения."
  end if
  MsgBox LSuccessMessages, vbSystemModal or vbInformation, "Конвертация старых трафаретов"

  if Len(LErrorMessages) > 0 then
    LAppProvider.DebugString "Ошибки конвертации:" & vbNewLine & LErrorMessages

    LFileName = LAppProvider.CreateTempFileName("txt")
    set LStream = LFileSystem.CreateTextFile(LFileName, True, True)
    LStream.Write LErrorMessages
    LStream.Close

    set LWshShell = CreateObject("WScript.Shell")
    LWshShell.Run "notepad.exe " & LFileName, 1, False
  end if

  set LFileSystem = Nothing
  set LAppProvider = Nothing
end sub

sub ExportAllTemplates
  Folder = GetParamValue("FOLDER")
  ExportTemplates = GetParamValue("EXPORT_TEMPLATES") = 1
  ExportValueHistory = GetParamValue("EXPORT_VALUE_HISTORY") = 1
  ExportUserReportTemplates = GetParamValue("EXPORT_USERREPORT_TEMPLATES") = 1

  if not (ExportTemplates or ExportValueHistory or ExportUserReportTemplates) then
    MsgBox "Не выбран ни один тип выгрузки.", vbSystemModal or vbCritical, "Выгрузка всех трафаретов"
    exit sub
  end if

  set LFileSystem = CreateObject("Scripting.FileSystemObject")

  if not LFileSystem.FolderExists(Folder) then
    MsgBox "Указанный каталог выгрузки не найден или не существует.", vbSystemModal or vbCritical, "Выгрузка всех трафаретов"
    exit sub
  end if

  set LAppProvider = CreateObject("ParusAppServerProvider.Provider")
  set LExcelApplication = CreateExcelApplication

  if ExportTemplates then
    Query.SQL.Text = _
      "select T.NRN, T.SNAME, E.SCODE, to_char(E.DBEGDATE, 'dd.mm.yyyy') DBEGDATE, T.BXLS" & vbNewLine &_
      "  from V_BLRPFRMTEMPLATES T" & vbNewLine &_
      " inner join V_BLREPFORMED E on E.NRN = T.NPRN" & vbNewLine &_
      " where dbms_lob.getlength(BXLS) > 0"

    InternalExportTemplates LFileSystem, LAppProvider, LExcelApplication, Folder, _
      "BXLS", "Трафарет - ", Array("NRN", "SCODE", "DBEGDATE", "SNAME")
  end if

  if ExportValueHistory then
    Query.SQL.Text = _
      "select H.NRN, T.SFORM_CODE, to_char(T.DBDATE, 'dd.mm.yyyy') DBDATE, T.SAGENT_CODE, H.SAUTHID, to_char(H.DREPORT_DATE, 'dd.mm.yyyy') DREPORT_DATE, BDATA" & vbNewLine &_
      "  from V_BLSUBREPORTSHIST H inner join V_BLSUBREPORTS T" & vbNewLine &_
      "    on H.NPRN = T.NRN" & vbNewLine &_
      " where dbms_lob.getlength(BDATA) > 0"

    InternalExportTemplates LFileSystem, LAppProvider, LExcelApplication, Folder, _
      "BDATA", "История значений - ", Array("NRN", "SFORM_CODE", "DBDATE", "SAGENT_CODE", "SAUTHID", "DREPORT_DATE")
  end if

  if ExportUserReportTemplates then
    Query.SQL.Text = _
      "select NRN, SCODE, SFILE_NAME, BTEMPLATE_DATA" & vbNewLine &_
      "  from V_USERREPORTS" & vbNewLine &_
      " where NREPORT_TYPE = 1" & vbNewLine &_
      "   and dbms_lob.getlength(BTEMPLATE_DATA) > 0"

    InternalExportTemplates LFileSystem, LAppProvider, LExcelApplication, Folder, _
      "BTEMPLATE_DATA", "Шаблон пользовательского отчета - ", Array("NRN", "SCODE", "SFILE_NAME")
  end if

  LExcelApplication.Quit
  set LExcelApplication = Nothing
  set LAppProvider = Nothing
  set LFileSystem = Nothing

  MsgBox "Успешно завершено.", vbSystemModal or vbInformation, "Выгрузка всех трафаретов"
end sub
