Option Explicit

Public Sub Main()
    Dim cn As New ADODB.Connection
    Dim s As String, sPath As String
    
    sPath = App.Path & "\TestDBFs\"
    On Error GoTo Err_
    If Len(Dir(sPath, vbDirectory)) =  0  Then MkDir sPath
    On Error Resume Next
    s = Dir$(App.Path & "\DBF\*.dbf")
    Do While Len(s)
        Kill App.Path & "\DBF\" & s
        s = Dir$
    Loop
    On Error GoTo Err_
    
    Set cn = New ADODB.Connection
    cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cn.Open "Data Source=" & sPath & ";Extended Properties=dBASE IV"
    ' OEM
    cn.Execute "CREATE TABLE tbOEM (t TEXT(50))"
    cn.Execute "INSERT INTO tbOEM (t) VALUES ('Проверочка OEM')"
    
    ' ANSII
    cn.Execute "CREATE TABLE tbANSII (t TEXT(50))"
    If ChangeDbfCodePageToANSII(sPath & "tbANSII.DBF") Then
        cn.Execute "INSERT INTO tbANSII (t) VALUES ('Проверочка ANSII')"
    End If
    cn.Close
    Exit Sub

Err_:
    With cn.Errors
        If .Count Then
            With .Item( 0 )
                If .NativeError = - 329323426  And .Number = - 2147467259  Then Resume
            End With
        End If
    End With
    MsgBox Err.Description, vbCritical
End Sub

Public Function ChangeDbfCodePageToANSII(sDbfPath As String) As Boolean
    Dim iHFile As Integer, s As String, b As Byte
    
    On Error GoTo Err_
    iHFile = FreeFile
    Open sDbfPath For Binary Access Read Write Lock Read Write As #iHFile
    Seek #iHFile,  30 
    Get #iHFile, , b
    If b <>  87  Then
        Seek #iHFile,  30 
        Put #iHFile, , CByte( 87 )
    End If
    Close #iHFile: iHFile =  0 
    ChangeDbfCodePageToANSII = True
    Exit Function
    
Err_:
    s = Err.Description
    If iHFile Then Close #iHFile: iHFile =  0 
    MsgBox s, vbCritical
End Function

Option Explicit

Public Sub Main()
    Dim cn As New ADODB.Connection
    Dim s As String, sPath As String
    
    sPath = App.Path & "\TestDBFs\"
    On Error GoTo Err_
    If Len(Dir(sPath, vbDirectory)) =  0  Then MkDir sPath
    On Error Resume Next
    s = Dir$(App.Path & "\DBF\*.dbf")
    Do While Len(s)
        Kill App.Path & "\DBF\" & s
        s = Dir$
    Loop
    On Error GoTo Err_
    
    Set cn = New ADODB.Connection
    cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cn.Open "Data Source=" & sPath & ";Extended Properties=dBASE IV"
    ' OEM
    cn.Execute "CREATE TABLE tbOEM (t TEXT(50))"
    cn.Execute "INSERT INTO tbOEM (t) VALUES ('Проверочка OEM')"
    
    ' ANSII
    cn.Execute "CREATE TABLE tbANSII (t TEXT(50))"
    If ChangeDbfCodePageToANSII(sPath & "tbANSII.DBF") Then
        cn.Execute "INSERT INTO tbANSII (t) VALUES ('Проверочка ANSII')"
    End If
    cn.Close
    Exit Sub

Err_:
    With cn.Errors
        If .Count Then
            With .Item( 0 )
                If .NativeError = - 329323426  And .Number = - 2147467259  Then Resume
            End With
        End If
    End With
    MsgBox Err.Description, vbCritical
End Sub

Public Function ChangeDbfCodePageToANSII(sDbfPath As String) As Boolean
    Dim iHFile As Integer, s As String, b As Byte
    
    On Error GoTo Err_
    iHFile = FreeFile
    Open sDbfPath For Binary Access Read Write Lock Read Write As #iHFile
    Seek #iHFile,  30 
    Get #iHFile, , b
    If b <>  87  Then
        Seek #iHFile,  30 
        Put #iHFile, , CByte( 87 )
    End If
    Close #iHFile: iHFile =  0 
    ChangeDbfCodePageToANSII = True
    Exit Function
    
Err_:
    s = Err.Description
    If iHFile Then Close #iHFile: iHFile =  0 
    MsgBox s, vbCritical
End Function

Option Explicit

Public Sub Main()
    Dim cn As New ADODB.Connection
    Dim s As String, sPath As String
    
    sPath = App.Path & "\TestDBFs\"
    On Error GoTo Err_
    If Len(Dir(sPath, vbDirectory)) =  0  Then MkDir sPath
    On Error Resume Next
    s = Dir$(sPath & "*.dbf")
    Do While Len(s)
        Kill sPath & s
        s = Dir$
    Loop
    On Error GoTo Err_
    
    Set cn = New ADODB.Connection
    cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cn.Open "Data Source=" & sPath & ";Extended Properties=dBASE IV"
    ' OEM
    cn.Execute "CREATE TABLE tbOEM (t TEXT(50))"
    cn.Execute "INSERT INTO tbOEM (t) VALUES ('Проверочка OEM')"
    
    ' ANSII
    cn.Execute "CREATE TABLE tbANSII (t TEXT(50))"
    If ChangeDbfCodePageToANSII(sPath & "tbANSII.DBF") Then
        cn.Execute "INSERT INTO tbANSII (t) VALUES ('Проверочка ANSII')"
    End If
    cn.Close
    Exit Sub

Err_:
    With cn.Errors
        If .Count Then
            With .Item( 0 )
                If .NativeError = - 329323426  And .Number = - 2147467259  Then Resume
            End With
        End If
    End With
    MsgBox Err.Description, vbCritical
End Sub

Public Function ChangeDbfCodePageToANSII(sDbfPath As String) As Boolean
    Dim iHFile As Integer, s As String, b As Byte
    
    On Error GoTo Err_
    iHFile = FreeFile
    Open sDbfPath For Binary Access Read Write Lock Read Write As #iHFile
    Seek #iHFile,  30 
    Get #iHFile, , b
    If b <>  87  Then
        Seek #iHFile,  30 
        Put #iHFile, , CByte( 87 )
    End If
    Close #iHFile: iHFile =  0 
    ChangeDbfCodePageToANSII = True
    Exit Function
    
Err_:
    s = Err.Description
    If iHFile Then Close #iHFile: iHFile =  0 
    MsgBox s, vbCritical
End Function

    Set cn = New ADODB.Connection
    cn.Provider = "Microsoft.Jet.OLEDB.4.0"
    cn.Open "Data Source=""" & sPath & """;Extended Properties=dBASE IV"
    ' OEM
    cn.Execute "CREATE TABLE tbOEM (t CHAR(50))"
    ' ANSII
    cn.Execute "CREATE TABLE tbANSII (t TEXT(50))"
    ChangeDbfCodePageToANSII sPath & "tbANSII.DBF"

    Set cn = New ADODB.Connection
    cn.Provider = "VFPOLEDB.1"
    cn.Open "Data Source=""" & sPath & """;Collating Sequence=RUSSIAN"
    
    cn.Execute "INSERT INTO tbOEM (t) VALUES ('Проверочка OEM')"
    cn.Execute "INSERT INTO tbANSII (t) VALUES ('Проверочка ANSII')"