Как создать файл dbf и определить кодировку в Блокноте или VBA

у нас радость .... лол

этот тестовый код создает файл dbf из данных на листе Excel

создает таблицу и вставляет одну запись

Sub dbfTest()

' NOTE:  put this test data at top of worksheet (A1:F2)

' Name    Date        Code    Date2       Description    Amount
' frank  11/12/2017  234.00  11/20/2018   paint          $1.34



'   ref: microsoft activex data objects

    Dim path As String
    Dim fileName As String

    filePath = "C:\database\"
    fileName = "test"


    Dim dc As Range
    Dim typ As String
    Dim fieldName As String
    Dim createSql As String

    createSql = "create table " + fileName + " ("          ' the create table query produces the file in directory

    Dim a As Variant

    For Each dc In Range("a1:e1")

        fieldName = dc.Value
        a = dc.offset(1).Value

        Select Case VarType(a)
            Case vbString:   typ = "varchar(100)"
            Case vbBoolean:  typ = "varchar(10)"
            Case vbInteger:  typ = "int"
            Case vbLong:     typ = "Double"
            Case vbDate:     typ = "TimeStamp"
            Case Else:       typ = "varchar(5)"            ' default for undefined types
        End Select

        createSql = createSql + " [" + fieldName + "]" + " " + typ + ","

    Next dc

    createSql = Left(createSql, Len(createSql) - 1) + ")"

    Debug.Print createSql

    Dim conn As ADODB.connection
    Set conn = CreateObject("ADODB.Connection")

    conn.Open "DRIVER={Microsoft dBase Driver (*.dbf)};" & "DBQ=" & filePath                                    ' both work
'   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & filePath & ";Extended Properties=dBASE IV"

    Dim cmd As ADODB.Command
    Set cmd = CreateObject("ADODB.Command")

    cmd.ActiveConnection = conn

    cmd.CommandText = createSql
    cmd.Execute

    Dim insertSql As String
    insertSql = "insert into " + fileName + " values("

    For Each dc In Range("a2:e2")
        insertSql = insertSql + "'" + CStr(dc.Value) + "',"
    Next dc

    insertSql = Left(insertSql, Len(insertSql) - 1) + ")"

    Debug.Print insertSql

    cmd.CommandText = insertSql

    cmd.Execute

    conn.Close
    Set conn = Nothing

End Sub

мое исследование завершено. Кодировка системы Ирана на самом деле ascii, а не unicode. он использует значения ascii для представления части персидского алфавита.

проблема с преобразованием из юникода в кодировку иранской системы заключается в том, что любая буква пишется совершенно по-разному в зависимости от того, где в слове она расположена. у вас есть «изолированные», «начальные», «средние» и «конечные» формы большинства букв.

это как верхний и нижний регистр на стероидах... лол

ссылка: https://www.math.nmsu.edu/~mleisher/Software/csets/IRANSYSTEM.TXT

поэтому потребуется дополнительный процесс для преобразования текста Unicode в Excel в эквивалентную строку кодировки системы Ирана перед сохранением в базе данных.

код создает таблицу с одним текстовым полем и хранит 3 записи

Sub dbfTestWork()

'   ref: microsoft activex data objects

    Dim filePath As String
    Dim fileName As String

    filePath = "C:\database\"
    fileName = "test"

    Dim conn As ADODB.Connection
    Set conn = CreateObject("ADODB.Connection")

    conn.Open "Driver={Microsoft dBase Driver (*.dbf)};Dbq=" + filePath + ";"

    'conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & filePath & ";Extended Properties=dBASE IV;"

    Dim fil As String
    fil = filePath & fileName & ".dbf"
    If Not Dir(fil, vbDirectory) = vbNullString Then Kill fil  ' delete file if it exists

    Dim cmd As ADODB.Command
    Set cmd = CreateObject("ADODB.Command")

    cmd.ActiveConnection = conn

    cmd.CommandText = "create table test ([testTextData] char(20))"
    cmd.Execute

    Dim nFileNum As Integer
    nFileNum = FreeFile                                                           ' Get an available file number from the system
    Open filePath & fileName & ".dbf" For Binary Lock Read Write As #nFileNum     ' Open the file in binary mode.  Locks are optional
    Put #nFileNum, 30, CByte(1)                                                   ' set language driver id (LDID)   0x01 = ascii encoding
    Close #nFileNum

'   Debug.Print Range("e2").Value

    Dim aaa As String
    aaa = StrConv(Range("e2").Value, vbUnicode)
'   Debug.Print aaa

    Dim cmdStr As String
    cmdStr = "insert into test values ('"

    Dim ccc As Variant
    For Each ccc In Array("ac", "92", "9e", "20", "93", "a1", "fe", "a4")   ' one of these two should store
        cmdStr = cmdStr & Chr(CDec("&h" & ccc))                             ' "good morning" in persian
    Next ccc
    cmdStr = cmdStr & "');"
    cmd.CommandText = cmdStr
    cmd.Execute

    cmdStr = "insert into test values ('"
    For Each ccc In Array("a4", "fe", "a1", "93", "20", "9e", "92", "ac")
        cmdStr = cmdStr & Chr(CDec("&h" & ccc))
    Next ccc
    cmdStr = cmdStr & "');"
    cmd.CommandText = cmdStr
    cmd.Execute

    cmd.CommandText = "insert into test values ('abc123');"
    cmd.Execute

    conn.Close
    Set conn = Nothing

End Sub
'