Public Function testW(noTable As Long)
Dim str As String
Dim p, e, k As Long
Dim sql As String
Dim strPath As String

strPath = CurrentProject.Path
str = File2StrB(strPath & "\StrategyTester.htm")
p = 0
For k = 1 To noTable
    p = p + 1
    p = InStr(p, str, "<table")
    e = InStr(p, str, "</table>")
Next k

str = Mid(str, p, e - p + 8)
Dim b As Boolean
b = SaveTextToFile(str, strPath & "\tmpFile.html", "utf-16")
sql = "SELECT * from [table] in ''[HTML Import;DATABASE=" & strPath & "\tmpFile.html;HDR=Yes]"
CurrentDb.QueryDefs("q1").sql = sql
DoCmd.OpenQuery "q1"
End Function

Public Function File2StrB(sPath As String) As String ' &#247;&#242;&#229;&#237;&#232;&#229; &#244;&#224;&#233;&#235;&#224; &#226; &#241;&#242;&#240;&#238;&#234;&#238;&#226;&#243;&#254; &#239;&#229;&#240;&#229;&#236;&#229;&#237;&#237;&#243;&#254;
Dim txt As String
Dim sLine As String
Dim fn As Long
fn = FreeFile
Dim TheBytes() As Byte
ReDim TheBytes(FileLen(sPath) - 1)
    Open sPath For Binary Access Read As fn
        Get #fn, , TheBytes()
    Close fn
File2StrB = StrConv(TheBytes(), vbUnicode)
End Function

Function SaveTextToFile(ByVal txt$, ByVal filename$, Optional ByVal encoding$ = "windows-1251") As Boolean
    ' функция сохраняет текст txt в кодировке Charset$ в файл filename$
    On Error Resume Next: Err.Clear
    Select Case encoding$
 
        Case "windows-1251", "", "ansi"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(filename, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing
 
        Case "utf-16", "utf-16LE"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(filename, True, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing
 
        Case "utf-8noBOM"
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = "utf-8": .Open
                .WriteText txt$
 
                Set binaryStream = CreateObject("ADODB.Stream")
                binaryStream.Type = 1: binaryStream.Mode = 3: binaryStream.Open
                .Position = 3: .CopyTo binaryStream        'Skip BOM bytes
                .flush: .Close
                binaryStream.SaveToFile filename$, 2
                binaryStream.Close
            End With
 
        Case Else
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = encoding$: .Open
                .WriteText txt$
                .SaveToFile filename$, 2        ' сохраняем файл в заданной кодировке
                .Close
            End With
    End Select
    SaveTextToFile = Err = 0: DoEvents
End Function