Attribute VB_Name = "Модуль3"

#If Win64 Then
    Public Declare PtrSafe Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" _
            (ByVal hKey As Long, ByVal dwIndex As Long, _
            ByVal lpName As String, _
            ByVal cbName As Long) As Long
    Public Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
            (ByVal hKey As Long, ByVal lpSubKey As String, _
            ByVal ulOptions As Long, ByVal samDesired As Long, _
            phkResult As Long) As Long
    Public Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
#Else
    Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" _
            (ByVal hKey As Long, ByVal dwIndex As Long, _
            ByVal lpName As String, _
            ByVal cbName As Long) As Long
    Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
            (ByVal hKey As Long, ByVal lpSubKey As String, _
            ByVal ulOptions As Long, ByVal samDesired As Long, _
            phkResult As Long) As Long
    Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
#End If

Public Const KEY_QUERY_VALUE = &H8
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const ERROR_SUCCESS = 0&
Global Const ERROR_NO_MORE_ITEMS = 259
Public bDeleteEmptyRows As Boolean

Function GetODBCDriver() As String
    Dim lcDriver As String, lcKey As String
    Dim hKey As Long, lnSize As Long, e As Long, i As Long
    Dim llFox As Boolean, llVisual As Boolean
    e = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI", 0, KEY_QUERY_VALUE, hKey)
    i = 0
    llFox = False
    llVisual = False
    Do
        lcKey = Space(250)
        lnSize = Len(lcKey)
        e = RegEnumKey(hKey, i, lcKey, lnSize)
        If Trim(lcKey) <> "" Then
            lcDriver = Mid(Trim(lcKey), 1, Len(Trim(lcKey)) - 1)
            llFox = llFox Or lcDriver Like "Microsoft FoxPro Driver*"
            llVisual = llVisual Or lcDriver Like "Microsoft Visual FoxPro Driver*"
        End If
        i = i + 1
    Loop While e = ERROR_SUCCESS
    RegCloseKey hKey
    GetODBCDriver = IIf(llVisual, "Microsoft Visual FoxPro Driver", IIf(llFox, "Microsoft FoxPro Driver (*.dbf)", "Microsoft Visual FoxPro Driver"))
End Function

Function LoadVFPData_OLEDB(ByRef qt As QueryTable, startRange As Range, lcPath As String, lcSelect As String, bFieldNames As Boolean) As Long
    Dim nRet As Integer
    nRet = 0
    On Error GoTo Err0
    Dim cn As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Provider = "VFPOLEDB"
    cn.ConnectionString = "Data Source=" + lcPath + ";Collating Sequence=MACHINE;"
    cn.Open
    Dim rs As Object
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open lcSelect, cn
    Set qt = startRange.Parent.QueryTables.Add(rs, startRange)
    qt.BackgroundQuery = False
    qt.FieldNames = bFieldNames
    qt.Refresh
    GoTo m1
Err0:
    nRet = -1
m1:
    On Error GoTo 0
    LoadVFPData_OLEDB = nRet
End Function

Function LoadVFPData_ODBC(ByRef qt As QueryTable, startRange As Range, lcPath As String, lcSelect As String, bFieldNames As Boolean) As Long
    Dim nRet As Integer, odbcDriver As String, odbcstr As String
    nRet = 0
    On Error GoTo Err0
    odbcDriver = GetODBCDriver()
    odbcstr = "ODBC;" + _
        "Driver=" + odbcDriver + ";" + _
        "UID=admin;SourceType=DBF;" + _
        "DefaultDir=" + lcPath + "\;" + _
        "DBQ=" + lcPath + "\;" + _
        "SourceDB=" + lcPath + "\;"
    Set qt = startRange.Parent.QueryTables.Add(odbcstr, startRange, lcSelect)
    qt.BackgroundQuery = False
    qt.FieldNames = bFieldNames
    qt.Refresh
    GoTo m1
Err0:
    nRet = -1
m1:
    On Error GoTo 0
    LoadVFPData_ODBC = nRet
End Function

Function LoadVFPData(startRange As Range, lcPath As String, lcSelect As String, Optional ByRef rowsCount As Long, Optional ByRef columnsCount As Integer, Optional bFieldNames As Boolean = True) As Long
    Dim nRet As Long, qt As QueryTable
    nRet = 0
    lcPath = IIf(lcPath = "", ThisWorkbook.Path, lcPath)
    If Mid(lcPath, Len(lcPath)) <> "\" Then
        lcPath = lcPath + "\"
    End If
    
    nRet = LoadVFPData_OLEDB(qt, startRange, lcPath, lcSelect, bFieldNames)
    If nRet < 0 Then
        nRet = LoadVFPData_ODBC(qt, startRange, lcPath, lcSelect, bFieldNames)
    End If
       
    If nRet >= 0 Then
        columnsCount = qt.ResultRange.Columns.Count
        rowsCount = qt.ResultRange.Rows.Count - 1
        If rowsCount <= 2 Then
            rowsCount = 0
            Do While Not IsEmptyR(startRange.Parent.Range(Cells(rowsCount + startRange.Row + IIf(bFieldNames, 1, 0), 1), Cells(rowsCount + startRange.Row + IIf(bFieldNames, 1, 0), columnsCount)))
                rowsCount = rowsCount + 1
            Loop
        End If
        nRet = rowsCount
    Else
        nRet = -1
    End If
    Set qt = Nothing
    LoadVFPData = nRet
End Function

Function IsEmptyR(loRange) As Boolean
    Dim i, llEmpty
    llEmpty = True
    For i = 1 To loRange.Count
        llEmpty = llEmpty And IsEmpty(loRange.Item(i))
    Next i
    IsEmptyR = llEmpty
End Function


