How can creating dbf file, and define encoding in Notepad, or VBA

问题

what is DBF4 (dBase IV)(*.dbf) file fundamental format? And how can create these file in a same word editor as Notepad with typing?(Update:, or excel VBA?)

What is that's format specifications as:

Delimiter (Same as: , or tab or etc)
Separator (may Same as above!) (If these two are not synonymy)
Row End character: (Same as vbCrLf)
Defining headers of columns(fields).
Code-Page of encoding: (same as: Unicode - 1256 or etc)
and others...

Please present an algorithm for creating this DB file format that made us able to create a same file easily by a VBA method which creates a text file. (Update Or using built-in VBA or its references methods.)

I using below for creating text file.

Sub CsvExportRange(rngRange As Object, strFileName As String, strCharset, strSeparator As String, strRowEnd As String, NVC As Boolean) 'NVC: _
Null Value Control (If cell contain Null value, suppose reached end of range), d: delimiter

Dim rngRow As Range
Dim objStream As Object
Dim i, lngFR, lngLR As Long 'lngFR: First Row, lngLR: Last Row

lngFR = rngRange.SpecialCells(xlCellTypeVisible).Rows(1).row - rngRange.Rows(1).row + 1
lngLR = rngRange.End(xlDown).row - rngRange.Rows(1).row + 1

Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 2
objStream.Charset = strCharset
objStream.Open

For i = lngFR To lngLR
    If Not (rngRange.Rows(i).EntireRow.Hidden) Then
        If IIf(NVC, (Cells(i + rngRange.Rows(1).row - 1, _
            rngRange.SpecialCells(xlCellTypeVisible).Columns(1).column).Value = vbNullString), False) Then Exit For
        objStream.WriteText CsvFormatRow(rngRange.Rows(i), strSeparator, strRowEnd)
    End If
Next i

objStream.SaveToFile strFileName, 2
objStream.Close
End Sub
Function CsvFormatRow(rngRow As Variant, strSeparator As String, strRowEnd As String) As String

Dim arrCsvRow() As String

ReDim arrCsvRow(rngRow.SpecialCells(xlCellTypeVisible).Cells.Count - 1)
Dim rngCell As Range
Dim lngIndex As Long

lngIndex = 0

For Each rngCell In rngRow.SpecialCells(xlCellTypeVisible).Cells
    arrCsvRow(lngIndex) = CsvFormatString(rngCell.Value, strSeparator)
    lngIndex = lngIndex + 1
Next rngCell

CsvFormatRow = Join(arrCsvRow, strSeparator) & strRowEnd

End Function
Function CsvFormatString(strRaw, strSeparator As String) As String

Dim boolNeedsDelimiting As Boolean

Dim strDelimiter, strDelimiterEscaped As String

strDelimiter = """"
strDelimiterEscaped = strDelimiter & strDelimiter

boolNeedsDelimiting = InStr(1, strRaw, strDelimiter) > 0 _
    Or InStr(1, strRaw, chr(10)) > 0 _
    Or InStr(1, strRaw, strSeparator) > 0

CsvFormatString = strRaw

If boolNeedsDelimiting Then
    CsvFormatString = strDelimiter & _
        Replace(strRaw, strDelimiter, strDelimiterEscaped) & _
        strDelimiter
End If

End Function

(Forgotten source)

Because I reached this: I should create a dbf file from my Excel Range by hand! After searching founded web sources.

Updated:

How can declare encoding of DBF?

About encoding that needed, considerable ones is Commonplace in this issue is Iran System encoding.

How can I store data with suitable encoding as Iran System in DB table records?

回答1:

we have joy .... lol

this test code creates a dbf file from data in excel worksheet

creates a table and inserts one record

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

回答2:

my research has concluded. the Iran System encoding is actually ascii, it is not unicode. it uses ascii values to represent some of the Persian alphabet.

the problem with converting from unicode to Iran System encoding is that any letter is written completely differently depending where in the word it is positioned. you have "isolated", "initial", "medial" and "final" forms of most of the letters.

it is like upper and lower case on steroids ... lol

ref: https://www.math.nmsu.edu/~mleisher/Software/csets/IRANSYSTEM.TXT

so additional process would be needed to convert unicode text in excel into an equivalent Iran System encoding string before storing in database.

the code creates a table with one text field and stores 3 records

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
'

来源：https://stackoverflow.com/questions/45989548/how-can-creating-dbf-file-and-define-encoding-in-notepad-or-vba

标签

vba

dbf

pdb-files