Attribute VB_Name = "excel_client"
Option Explicit

#If Win64 Then
  Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
  Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
#Else
  Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
  Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
#End If
' --------------------------------------------------------------------------------------------------------------
Sub MakeReport()
  Dim oSheetNastr As Worksheet, nIdx As Long, nHWnd As Long, oSheetForm As Worksheet, _
  oSheet As Worksheet, cExcelClientInitProc As String, oRange As Range, oBook As Workbook, _
    cRepPath As String, cRepName As String, cDataPath As String, cClientID As String, _
    cFileExt As String

  Application.StatusBar = "Подождите ... Идет загрузка данных"
  nHWnd = FindWindow("XLMAIN", 0)
  LockWindowUpdate (nHWnd)
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Application.Calculation = -4135 ' xlCalculationManual

  cRepPath = VBA.Trim(ThisWorkbook.Sheets(1).[a2].Value)
  cRepPath = cRepPath + VBA.IIf(cRepPath <> "", VBA.IIf(VBA.Mid(cRepPath, VBA.Len(cRepPath), 1) = "\", "", "\"), "")
  cRepName = VBA.Trim(ThisWorkbook.Sheets(1).[B2].Value)

  cDataPath = VBA.Trim(ThisWorkbook.Sheets(1).[C2].Value)
  If cDataPath <> "" Then
    cDataPath = cDataPath + VBA.IIf(VBA.Mid(cDataPath, VBA.Len(cDataPath), 1) = "\", "", "\")
  End If
  cDataPath = VBA.IIf(cDataPath = "", ThisWorkbook.Path + "\", cDataPath)
  cFileExt = VBA.IIf(GetExcelBitMode64(), ".xml", ".dbf")

  Set oSheetNastr = Application.ActiveWorkbook.Worksheets.Add
  Call LoadNastr(cDataPath, "c_nastr" + cFileExt, oSheetNastr.[a1])

  ' Открываем шаблон документа
  Application.Workbooks.Open Filename:=cRepPath + cRepName
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  ActiveWindow.ScrollColumn = 1
  ActiveWindow.ScrollRow = 1
  Range("A1").Select

  cExcelClientInitProc = ""
  If ExistsNamesWS(oSheetNastr, "INIT_PROC") Then
    cExcelClientInitProc = oSheetNastr.Range("INIT_PROC").Value
  End If

  If ExistsNamesWS(oSheetNastr, "TYPE_DOC") Then
    Select Case oSheetNastr.Range("TYPE_DOC").Value

    Case "EXCEL_CLIENT_GZ_POST_807"
      cClientID = "ujcpfrfprkbtyn"
      Call LoadData(cDataPath, "C_DATA" + cFileExt, "C_DATA", False, cClientID)
      Set oBook = Application.ActiveWorkbook
      If ExistsWorksheet(oBook, "C_DATA") Then
        If ExistsNamesWS(oBook.Sheets("C_DATA"), "C_DATA") Then
          Set oRange = oBook.Sheets("C_DATA").Range("C_DATA")
          For nIdx = 1 To oRange.Rows.count
            If oRange.Cells(nIdx, 3).Value > 0 Then
              Call LoadData(cDataPath, "C_DATA" + VBA.Trim(oRange.Cells(nIdx, 2).Value) + cFileExt, _
                            VBA.Trim(oRange.Cells(nIdx, 1).Value), False, cClientID)
            End If
          Next nIdx
        End If

        oSheetNastr.Activate
        oSheetNastr.Select
        oSheetNastr.Copy After:=oBook.Sheets("C_DATA")

        Set oSheet = oBook.ActiveSheet
        oSheet.Name = "C_NASTR"
        Call ModifySheet(1, oSheet, cClientID)
        oSheet.Visible = 2 ' xlSheetVeryHidden
        Set oSheet = Nothing
      End If

      ' FORM_SK
      If ExistsWorksheet(oBook, "FORM_SK") Then
        Set oSheetForm = oBook.Worksheets("FORM_SK")
        Set oSheet = Application.ActiveSheet
        oSheetForm.Activate
        oSheetForm.Visible = -1 ' xlSheetVisible
        Call ModifySheet(2, oSheetForm, cClientID)

        ' Закрыть "Номер извещения о проведении торгов"
        If ExistsNamesWS(oSheetNastr, "nCheck_1") Then
          If oSheetNastr.Range("nCheck_1").Value = 1 Then
            If ExistsNamesWS(oSheetForm, "NUM_IZV") Then
              oSheetForm.Range("NUM_IZV").Select
              Selection.Locked = True
              Selection.FormulaHidden = False
              Selection.ClearComments
            End If
          End If
        End If

        ' Закрыть "Номер реестровой записи"
        If ExistsNamesWS(oSheetNastr, "nCheck_2") Then
          If oSheetNastr.Range("nCheck_2").Value = 1 Then
            If ExistsNamesWS(oSheetForm, "NUM_BX") Then
              oSheetForm.Range("NUM_BX").Select
              Selection.Locked = True
              Selection.FormulaHidden = False
              Selection.ClearComments
            End If
          End If
        End If

        ' Закрыть "Дата регистрации"
        If ExistsNamesWS(oSheetNastr, "nCheck_3") Then
          If oSheetNastr.Range("nCheck_3").Value = 1 Then
            If ExistsNamesWS(oSheetForm, "DATE_REG") Then
              oSheetForm.Range("DATE_REG").Select
              Selection.Locked = True
              Selection.FormulaHidden = False
              Selection.ClearComments
            End If
          End If
        End If

        ' Источник финансирования
        If ExistsNamesWS(oSheetNastr, "SRC_FIN") Then
          If VBA.Trim(oSheetNastr.Range("SRC_FIN").Value) <> "" Then
            If ExistsNamesWS(oSheetForm, "NAME_PUB") Then
              oSheetForm.Range("NAME_PUB").Select
              Selection.Locked = True
              Selection.FormulaHidden = False
              Selection.ClearComments
              oSheetForm.Range("NAME_PUB") = VBA.Trim(oSheetNastr.Range("SRC_FIN").Value)
            End If
          End If
        End If

        Call ModifySheet(1, oSheetForm, cClientID)
        oSheetForm.Visible = 2 ' xlSheetVeryHidden
        oSheet.Activate
        Set oSheet = Nothing
        Set oSheetForm = Nothing
      End If

      ' Реквизиты
      If ExistsWorksheet(oBook, "Реквизиты") Then
        Set oSheetForm = oBook.Worksheets("Реквизиты")
        Set oSheet = Application.ActiveSheet
        oSheetForm.Activate
        oSheetForm.Visible = -1 ' xlSheetVisible
        Call ModifySheet(2, oSheetForm, cClientID)

        ' Код ОФК
        If ExistsNamesWS(oSheetNastr, "KOD_TOFK") Then
          If VBA.Trim(oSheetNastr.Range("KOD_TOFK").Value) <> "" Then
            If ExistsNamesWS(oSheetForm, "KOD_TOFK") Then
              oSheetForm.Range("KOD_TOFK").Select
              Selection.Locked = True
              Selection.FormulaHidden = False
              Selection.ClearComments
              oSheetForm.Range("KOD_TOFK") = VBA.Trim(oSheetNastr.Range("KOD_TOFK").Value)
            End If
          End If
        End If

        ' Наименование ОФК
        If ExistsNamesWS(oSheetNastr, "NAME_TOFK") Then
          If VBA.Trim(oSheetNastr.Range("NAME_TOFK").Value) <> "" Then
            If ExistsNamesWS(oSheetForm, "NAME_TOFK") Then
              oSheetForm.Range("NAME_TOFK").Select
              Selection.Locked = True
              Selection.FormulaHidden = False
              Selection.ClearComments
              oSheetForm.Range("NAME_TOFK") = VBA.Trim(oSheetNastr.Range("NAME_TOFK").Value)
            End If
          End If
        End If

        Call ModifySheet(1, oSheetForm, cClientID)
        oSheet.Activate
        Set oSheet = Nothing
        Set oSheetForm = Nothing
      End If

    Case "EXCEL_CLIENT_RRO"
      cClientID = "httcnhhjrkbtyn"
      Call LoadData(cDataPath, "C_DATA" + cFileExt, "C_DATA", False, cClientID)
      Set oBook = Application.ActiveWorkbook
      If ExistsWorksheet(oBook, "C_DATA") Then
        If ExistsNamesWS(oBook.Sheets("C_DATA"), "C_DATA") Then
          Set oRange = oBook.Sheets("C_DATA").Range("C_DATA")
          For nIdx = 1 To oRange.Rows.count
            if oRange.Cells(nIdx, 3).Value > 0 Then
              Call LoadData(cDataPath, "C_DATA" + VBA.Trim(oRange.Cells(nIdx, 2).Value) + cFileExt, _
                            VBA.Trim(oRange.Cells(nIdx, 1).Value), False, cClientID)
            End If
          Next nIdx
        End If

        oSheetNastr.Activate
        oSheetNastr.Select
        oSheetNastr.Copy After:=oBook.Sheets("C_DATA")

        Set oSheet = oBook.ActiveSheet
        oSheet.Name = "C_NASTR"
        Call ModifySheet(1, oSheet, cClientID)
        oSheet.Visible = 2 ' xlSheetVeryHidden
        Set oSheet = Nothing
      End If

    End Select
  End If

  oSheetNastr.Delete
  LockWindowUpdate (0)
  Application.ScreenUpdating = True
  Application.StatusBar = False
  Application.DisplayAlerts = True
  Application.Visible = True
  Application.Calculation = -4105 ' xlCalculationAutomatic
  Application.ActiveWorkbook.Saved = True
  Application.ThisWorkbook.Windows(1).Visible = False
  Application.ThisWorkbook.Saved = True

  If cExcelClientInitProc <> "" Then
    nIdx = Application.Run(Application.ActiveWorkbook.Name + "!" + cExcelClientInitProc)
  End If
End Sub
' --------------------------------------------------------------------------------------------------------------
Sub LoadData(ByVal cDataPath As String, ByVal cDataName As String, ByVal cSheetName As String, _
             ByVal bDelHeaders As Boolean, ByVal cClientID As String)
  Dim oQTable As QueryTable, cOdbcDriver As String, cOdbcConnStr As String, oSheetSrc As Worksheet, _
      cDataSelect As String, oSheetDst As Worksheet, cRefers As String, nCol As Long, _
      oBookAct As Workbook, oXmlRange As Range


  Set oBookAct = Application.ActiveWorkbook
  Set oSheetSrc = oBookAct.Worksheets.Add
  cDataSelect = "SELECT * FROM " + cDataName
  cOdbcDriver = GetODBCDriver()
  cOdbcConnStr = "ODBC;" + _
                 "Driver=" + cOdbcDriver + ";" + _
                 "UID=admin;SourceType=DBF;" + _
                 "DefaultDir=" + cDataPath + ";" + _
                 "DBQ=" + cDataPath + ";" + _
                 "SourceDB=" + cDataPath + ";"

  If VBA.Dir(cDataPath + cDataName) <> "" And (VBA.Right(cDataName, 4) = ".dbf" Or VBA.Right(cDataName, 4) = ".xml") Then
    If VBA.Right(cDataName, 4) = ".dbf" Then
      Set oQTable = oSheetSrc.QueryTables.Add(cOdbcConnStr, oSheetSrc.Range("A1"), cDataSelect)
      oQTable.BackgroundQuery = False
      oQTable.FieldNames = True
      On Error GoTo Err1
      oQTable.Refresh
      On Error GoTo Err1
    End If

    If VBA.Right(cDataName, 4) = ".xml" Then
      Set oXmlRange = XmlImportFileToSheet(cXmlFileName:=cDataPath + cDataName, oBaseCell:=oSheetSrc.Range("A1"))
      If Not oXmlRange Is Nothing Then
        oSheetSrc.Names.Add Name:="ExternalData_1", _
                            RefersToR1C1:="=" + oSheetSrc.Name + "!" + oXmlRange.Address(ReferenceStyle:=-4150) ' xlR1C1
      Else
        GoTo Err1
      End If
    End If

    If ExistsWorksheet(oBookAct, cSheetName) Then
      Set oSheetDst = oBookAct.Worksheets(cSheetName)
    Else
      Set oSheetDst = oBookAct.Sheets.Add
      oSheetDst.Name = cSheetName
    End If

    oSheetDst.Visible = -1 ' xlSheetVisible
    Call ModifySheet(2, oSheetDst, cClientID)

    oSheetSrc.Activate
    oSheetSrc.Range("ExternalData_1").Select
    Selection.Copy

    oSheetDst.Activate
    oSheetDst.Range("A1").Select
    Selection.PasteSpecial Paste:=-4163, Operation:=-4142, SkipBlanks:=False, Transpose:=False ' Paste:=xlPasteValues, Operation:=xlNone

    cRefers = oSheetSrc.Names("ExternalData_1").RefersToR1C1
    cRefers = VBA.Right(cRefers, VBA.Len(cRefers) - VBA.InStr(cRefers, "!"))

    oSheetDst.Names.Add name:="data", RefersToR1C1:="=" & oSheetDst.Name & "!" & cRefers
    oSheetDst.Names.Add name:=oSheetDst.Name, RefersToR1C1:="=" & oSheetDst.Name & "!" & cRefers

    if bDelHeaders Then
      oSheetDst.Rows("1:1").Select
      Selection.Delete Shift:=-4162 ' xlUp
    Else
      oSheetDst.Rows("1:1").Select
      Selection.Copy
      
      oSheetDst.Rows("1:1").Select
      Selection.Insert Shift:=-4162 ' xlUp
      
      oSheetDst.Rows("2:2").Select
      Selection.Delete Shift:=-4162 ' xlUp

      oSheetDst.Range("A1").Select
      For nCol = 1 To oSheetDst.Range("data").Columns.Count
        Call InsertNameSheet(oSheetDst, VBA.UCase(oSheetDst.Cells(1, nCol).Value), "R1C" & nCol)
      Next nCol
    End If

    Call ModifySheet(1, oSheetDst, cClientID)
    oSheetDst.Visible = 2 ' xlSheetVeryHidden
    oSheetSrc.Delete
    GoTo ExitProc
  End If

Err1:
  oSheetSrc.Delete
  Call VBA.MsgBox("Ошибка загрузки данных!" + VBA.vbNewLine + "Файл: " + cDataPath + cDataName, _
                  VBA.vbCritical + VBA.vbOKOnly, "Ошибка")

ExitProc:
  Set oSheetSrc = Nothing
  Set oQTable = Nothing
End Sub
' --------------------------------------------------------------------------------------------------------------
Sub LoadNastr(ByVal cDataPath As String, ByVal cDataName As String, ByVal oNastr As Range)
  Dim nIdx As Long, nNastrRow As Integer, nNastrCol As Integer, oQTable As QueryTable, _
      cName As String, cText As String, nRowCnt As Integer, oXmlRange As Range, _
      cDataSelect As String, cOdbcDriver As String, cOdbcConnStr As String, _
      oSheetNastr As Worksheet

  cDataSelect = "SELECT * FROM " + cDataName
  cOdbcDriver = GetODBCDriver()
  cOdbcConnStr = "ODBC;" + _
                 "Driver=" + cOdbcDriver + ";" + _
                 "UID=admin;SourceType=DBF;" + _
                 "DefaultDir=" + cDataPath + ";" + _
                 "DBQ=" + cDataPath + ";" + _
                 "SourceDB=" + cDataPath + ";"

  If VBA.Dir(cDataPath + cDataName) <> "" And (VBA.Right(cDataName, 4) = ".dbf" Or VBA.Right(cDataName, 4) = ".xml") Then
    nNastrRow = oNastr.Row
    nNastrCol = oNastr.Column
    Set oSheetNastr = oNastr.Parent

    If VBA.Right(cDataName, 4) = ".dbf" Then
      oSheetNastr.Activate
      Set oQTable = oSheetNastr.QueryTables.Add(cOdbcConnStr, oNastr, cDataSelect)

      oQTable.BackgroundQuery = False
      oQTable.FieldNames = True
      On Error GoTo Err1
      oQTable.Refresh
      On Error GoTo 0
      nRowCnt = oQTable.ResultRange.Rows.Count
    End If
    
    If VBA.Right(cDataName, 4) = ".xml" Then
      Set oXmlRange = XmlImportFileToSheet(cXmlFileName:=cDataPath + cDataName, oBaseCell:=oNastr)
      If Not oXmlRange Is Nothing Then
        oSheetNastr.Names.Add Name:="ExternalData_1", _
                              RefersToR1C1:="=" + oSheetNastr.Name + "!" + oXmlRange.Address(ReferenceStyle:=-4150) ' xlR1C1
      Else
        GoTo Err1
      End If
      
      nRowCnt = oSheetNastr.Range("ExternalData_1").Rows.Count
    End If
    
    oSheetNastr.Parent.Names.Add Name:="NastrFields", _
                                 RefersToR1C1:="=" + oSheetNastr.Name + "!R" + VBA.Trim(VBA.Str(nNastrRow + 1)) + _
                                                                        "C" + VBA.Trim(VBA.Str(nNastrCol)) + _
                                                                        ":R" + VBA.Trim(VBA.Str(nNastrRow + nRowCnt)) + _
                                                                        "C" + VBA.Trim(VBA.Str(nNastrCol))
    For nIdx = 1 To nRowCnt
      cName = oSheetNastr.Cells(nNastrRow + nIdx, nNastrCol)
      If cName <> "" Then
        oSheetNastr.Parent.Names.Add Name:=cName, _
                                     RefersToR1C1:="=" + oSheetNastr.Name + "!R" + VBA.Trim(VBA.Str(nNastrRow + nIdx)) + _
                                                                            "C" + VBA.Trim(VBA.Str(nNastrCol + 1))
        If VBA.Mid(cName, 1, 1) <> "c" Then
          With oSheetNastr.Cells(nNastrRow + nIdx, nNastrCol + 1)
            If VBA.VarType(.Value) = 8 Then ' vbString
              cText = .Value
            Else
              cText = .Text
            End If
            .FormulaLocal = VBA.IIf(VBA.Mid(cText, 1, 1) = "=", " ", "") + cText
          End With
        End If
      End If
    Next nIdx
    GoTo ExitProc
  End If

Err1:
  Call VBA.MsgBox("Ошибка загрузки данных!" + VBA.vbNewLine + "Файл: " + cDataPath + cDataName, _
                  VBA.vbCritical + VBA.vbOKOnly, "Ошибка")

ExitProc:
  Set oQTable = Nothing
End Sub
' --------------------------------------------------------------------------------------------------------------
Function ExistsNamesWS(ByVal oSheet As Worksheet, ByVal cName As String) As Boolean
  Dim nIdx As Integer, oBook as Workbook

  If cName <> "" Then
    For nIdx = 1 To oSheet.Names.count
      If VBA.Mid(oSheet.Names(nIdx).Name, VBA.InStr(oSheet.Names(nIdx).Name, "!") + 1) = cName Then
        ExistsNamesWS = True
        Exit Function
      End If

      If oSheet.Names(nIdx).Name = cName Then
        ExistsNamesWS = True
        Exit Function
      End If
    Next

    Set oBook = oSheet.Parent
    For nIdx = 1 To oBook.Names.count
      If oBook.Names(nIdx).Name = cName Then
        ExistsNamesWS = True
        Exit Function
      End If
    Next
  End If

  ExistsNamesWS = False
End Function
' --------------------------------------------------------------------------------------------------------------
Sub ModifySheet(ByVal nMode As Long, ByVal oSheet As Worksheet, ByVal cClientID As String)
  If nMode = 1 Then
    oSheet.Protect Password:=cClientID, DrawingObjects:=True, Contents:=True, Scenarios:=True
  End If

  If nMode = 2 Then
    oSheet.Unprotect Password:=cClientID
  End If
End Sub
' --------------------------------------------------------------------------------------------------------------
Function ExistsWorksheet(ByVal oBook As Workbook, ByVal cName As String) As Boolean
  Dim oSheet As Worksheet, bFlag As Boolean

  bFlag = False
  For Each oSheet In oBook.Sheets
    If oSheet.Name = cName Then
      bFlag = True
    End If
  Next oSheet

  ExistsWorksheet = bFlag
End Function
' --------------------------------------------------------------------------------------------------------------
Sub InsertNameSheet(ByVal oSheet As Worksheet, ByVal cName As String, ByVal cAddress As String)
  If cName <> "" And cAddress <> "" Then
    If ExistsNamesWS(oSheet, cName) Then
      oSheet.Names(cName).Delete
    End If
    
    oSheet.Names.Add Name:=VBA.UCase(cName), RefersToR1C1:="=" & oSheet.Name & "!" & cAddress
  End If
End Sub
' --------------------------------------------------------------------------------------------------------------
Function GetExcelBitMode64() As Boolean
  #If Win64 Then
    GetExcelBitMode64 = True
  #Else
    GetExcelBitMode64 = False
  #End If
End Function
' --------------------------------------------------------------------------------------------------------------
Function ShowErrorEvent(Optional ByVal cSubName As String = "", _
                        Optional ByVal bShowMsgBox As Boolean = True, _
                        Optional ByVal cErrorMessageEnd As String = "", _
                        Optional ByVal bExecAppEnabled As Boolean = True) As String
  Dim cErrorMessage As String, nErr As Long
  
  cErrorMessage = VBA.IIf(cSubName = "", "", "Процедура(функция): " + cSubName + VBA.vbNewLine) _
          + "Ошибка! Номер: " + VBA.Trim(VBA.Str(Err.Number)) _
          + ", Источник: " + VBA.Trim(Err.Source) _
          + VBA.vbNewLine + "Описание: " + VBA.Trim(Err.Description)
  
  If VBA.Trim(cErrorMessageEnd) <> "" Then
    cErrorMessage = cErrorMessage + VBA.vbNewLine + cErrorMessageEnd
  End If
  
  ShowErrorEvent = cErrorMessage
  If bShowMsgBox Then
    Call VBA.MsgBox(cErrorMessage, VBA.vbOKOnly + VBA.vbCritical, "Ошибка в программе")
  End If
  
  If bExecAppEnabled Then
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Interactive = True
    Application.StatusBar = False
    Application.Calculation = xlCalculationAutomatic
  End If
End Function
' --------------------------------------------------------------------------------------------------------------
Function XmlCreateDomDocument(Optional ByRef cXmlVersion As String = "") As Variant
  Dim oXmlDoc As Variant, cXmlObject As String
  
  Set oXmlDoc = Nothing
  If cXmlVersion = "" Then
    cXmlVersion = "6.0"
  End If
  
  Select Case cXmlVersion
  Case "3.0"
    ' http://www.microsoft.com/downloads/details.aspx?familyid=28494391-052b-42ff-9674-f752bdca9582&displaylang=en
    cXmlObject = "MSXML2.DOMDocument.3.0"
  Case "4.0"
    ' http://www.microsoft.com/downloads/details.aspx?FamilyID=3144b72b-b4f2-46da-b4b6-c5d7485f2b42&DisplayLang=en
    cXmlObject = "MSXML2.DOMDocument.4.0"
  Case "6.0"
    ' http://www.microsoft.com/downloads/details.aspx?familyid=993C0BCF-3BCF-4009-BE21-27E85E1857B1&displaylang=en
    cXmlObject = "MSXML2.DOMDocument.6.0"
  Case Else
    cXmlObject = ""
    cXmlVersion = ""
  End Select
  
  If cXmlObject <> "" And oXmlDoc Is Nothing Then
    On Error GoTo LError
    Set oXmlDoc = CreateObject(cXmlObject)
    GoTo LExit

LError:
    Set oXmlDoc = Nothing
    Select Case cXmlVersion
    Case "3.0"
      cXmlVersion = ""
    Case "4.0"
      cXmlVersion = "3.0"
    Case "6.0"
      cXmlVersion = "4.0"
    Case Else
      cXmlVersion = ""
    End Select
    
    If cXmlVersion <> "" Then
      Set oXmlDoc = XmlCreateDomDocument(cXmlVersion)
    End If

LExit:
    On Error GoTo 0
  End If
  
  If cXmlVersion = "" Then
    Set oXmlDoc = Nothing
  End If
  
  Set XmlCreateDomDocument = oXmlDoc
End Function
' --------------------------------------------------------------------------------------------------------------
Function XmlImportFileToSheet(ByVal cXmlFileName As String, _
                              Optional ByVal cObjPath As String = "*", _
                              Optional ByVal cPropPath As String = "*", _
                              Optional ByVal oBaseCell As Range = Nothing) As Range
  Dim oXmlDoc As Variant, oNodeList As Variant, oObjNode As Variant, oPropNode As Variant, _
      nBaseRow As Long, nBaseCol As Long, nRowIdx As Long, nColIdx As Long, oBaseSheet As Worksheet, _
      nRowCount As Long, nColCount As Long
  
  On Error GoTo doError
  
  Set XmlImportFileToSheet = Nothing
  
  If oBaseCell Is Nothing Then
    Set oBaseCell = Application.ActiveCell
  End If
  nBaseRow = oBaseCell.Row
  nBaseCol = oBaseCell.Column
  Set oBaseSheet = oBaseCell.Parent
  
  Set oXmlDoc = XmlCreateDomDocument()
  Call oXmlDoc.Load(cXmlFileName)
  
  Set oNodeList = oXmlDoc.DocumentElement.SelectNodes(cObjPath)
  If oNodeList.Length > 0 Then
    nColIdx = 0
    
    Set oObjNode = oNodeList(0)
    For Each oPropNode In oObjNode.SelectNodes(cPropPath)
      oBaseSheet.Cells(nBaseRow, nBaseCol + nColIdx).Value = oPropNode.NodeName
      nColIdx = nColIdx + 1
    Next oPropNode
    
    nColCount = nColIdx
    oBaseSheet.Range(oBaseSheet.Cells(nBaseRow, nBaseCol), oBaseSheet.Cells(nBaseRow, nBaseCol + nColCount)).Font.Bold = True
    
    nRowIdx = 1
    For Each oObjNode In oNodeList
      nColIdx = 0
      
      For Each oPropNode In oObjNode.SelectNodes(cPropPath)
        oBaseSheet.Cells(nBaseRow + nRowIdx, nBaseCol + nColIdx).NumberFormat = "@"
        oBaseSheet.Cells(nBaseRow + nRowIdx, nBaseCol + nColIdx).Value = oPropNode.Text
        nColIdx = nColIdx + 1
      Next oPropNode
      
      If nColCount < nColIdx Then
        nColCount = nColIdx
      End If
      
      nRowIdx = nRowIdx + 1
    Next oObjNode
    
    nRowCount = nRowIdx
    Set XmlImportFileToSheet = oBaseSheet.Range(oBaseSheet.Cells(nBaseRow, nBaseCol), oBaseSheet.Cells(nBaseRow + nRowCount, nBaseCol + nColCount))
  End If
  
  Set oXmlDoc = Nothing
  Exit Function
  
doError:
  Set oXmlDoc = Nothing
  Call ShowErrorEvent("XmlImportFileToSheet")
End Function
' --------------------------------------------------------------------------------------------------------------
Function XmlImportRecordSetToString(ByVal oRecordSet As Variant, Optional ByVal cXsltTransform As String = "") As String
  Dim cXmlResult As String, oXmlDoc As Variant
  
  On Error GoTo doError
  
  cXmlResult = ""
  Set oXmlDoc = XmlCreateDomDocument()
  
  If Not oXmlDoc Is Nothing And Not oRecordSet Is Nothing Then
    If oRecordSet.State = 1 Then
      oRecordSet.MoveFirst
      Call oRecordSet.Save(oXmlDoc, 1)
      
      cXmlResult = oXmlDoc.XML
      If VBA.Trim(cXsltTransform) <> "" Then
        cXmlResult = XmlTransformToString(cXmlResult, cXsltTransform)
      End If
    End If
  End If
  
  Set oXmlDoc = Nothing
  XmlImportRecordSetToString = cXmlResult
  Exit Function
  
doError:
  XmlImportRecordSetToString = ""
  Call ShowErrorEvent("XmlImportRecordSetToString")
End Function
' --------------------------------------------------------------------------------------------------------------
Function XmlTransformToString(ByVal cXmString As String, Optional ByVal cXsltTransform As String = "") As String
  Dim cXmlResult As String, oXmlDoc As Variant, oXsltDoc As Variant
  
  On Error GoTo doError
  
  cXmlResult = ""
  Set oXmlDoc = XmlCreateDomDocument()
  Set oXsltDoc = XmlCreateDomDocument()
  
  If Not oXmlDoc Is Nothing And Not oXsltDoc Is Nothing Then
    Call oXmlDoc.LoadXML(cXmString)
    Call oXsltDoc.LoadXML(cXsltTransform)
    
    cXmlResult = oXmlDoc.TransformNode(oXsltDoc)
  End If
  
  Set oXmlDoc = Nothing
  Set oXsltDoc = Nothing
  XmlTransformToString = cXmlResult
  Exit Function
  
doError:
  XmlTransformToString = ""
  Call ShowErrorEvent("XmlTransformToString")
End Function
