如何在记事本或VBA中创建dbf文件和定义编码

什么是

DBF4（dBase IV）（*.dbf）

file基本格式？如何在与

记事本
相同的word编辑器中通过键入创建这些文件？（更新：或excel VBA？）

其格式规范是什么：


分隔符
（与：
、
或
选项卡
等相同）
分隔符
（可能与上面相同！）（如果这两个不是同义词）
行尾
字符：（与
vbCrLf
相同）
定义列（字段）的标题
编码的
代码页
：（同：
Unicode-1256
等）

和其他人

请提供一种创建此
DB
文件格式的算法，该算法使我们能够通过创建文本文件的
VBA
方法轻松创建相同的文件。
（更新或使用内置VBA或其引用方法。）

我使用下面的方法创建文本文件

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

（被遗忘的来源）

因为我做到了这一点：我应该从我的Excel
Range
手动创建一个
dbf
文件！经过搜索发现的网络资源

更新：

如何声明DBF的编码

关于需要的编码，在这个问题上相当多的是常见的是伊朗系统编码

如何将数据以合适的编码存储在DB表记录中作为伊朗系统？
我们很高兴。。。。哈哈

此测试代码从excel工作表中的数据创建dbf文件

创建一个表并插入一条记录

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值来表示一些波斯字母表

从unicode转换为伊朗系统编码的问题是，任何字母的书写方式都完全不同，这取决于它在单词中的位置。大多数字母都有“孤立”、“首字母”、“中间字母”和“末字母”形式

就像类固醇上的上下病例。。。哈哈

参考：

所以，在存储到数据库之前，需要额外的过程将excel中的unicode文本转换为等效的伊朗系统编码字符串

代码创建一个带有一个文本字段的表，并存储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
'

记事本只能将文件保存为纯文本。为什么要使用记事本创建DBF文件？？这和VBA有什么关系？你在网上研究过你的问题吗？你没有。。。。我做了一个搜索，第一个点击的是格式的描述。我用记事本创建什么是因为：我在导出Excel
Range
到
DBF
阶段遇到了一个问题，不希望找到一个用于装入导出器宏的代码。因此，我正在尝试找到内部
DBF
的结构和算法，以便使用
VBA
宏手动从我的excel
Range
创建此文件。如果使用记事本+，则可以切换到十六进制显示。这将向您显示文件的真实结构。。。。或者下载这个，用它来查看文件的内容，有这个。。。你的回答简短、漂亮、清晰、有用；这正是需要解决的问题@jsotola@：我正在开发您的代码，准备发布，并将在这里向您展示它的上传路径。请留下它作为答案。@jsotola@：在上面的代码中，如何将
代码页
或
编码
定义为
Unicode
？正在检查it@jsotola@：我需要Unicode编码的记录值（
CStr（dc.Value）
）。哪种数据类型可以为此字段定义Unicode？例如，我尝试了
typ=“nvarchar（100）”
，但
nvarchar
未被批准，并返回错误。@jsotola@：通过上述例程，我能够以DBF格式导出Excel。但这并不完整。我需要在目标DBF中定义编码。我到达了编码表以获得合适的编码，但如何定义DBF编码？使用
aaa=StrConv（Range（“e2”）.Value，vbUnicode）
？在上面值得一提的答案中，使用reference和
CDec（）
，我将为相应的等效Unicode和伊朗系统ASCII代码创建
map
数组，然后使用write-property函数转换这两个文本字符串，使用上面映射的字典和字符识别。然后将结果发送给您（当我成功时）。非常感谢，以上讨论的结果准备好呈现，我将准备好的程序发送给您。说明在伊朗国家，有一项政府每月定期为分包商提供的任务，即准备保险清单报告。我为伊朗政府保险清单编制了清单生成器，对其指定的字符代码进行解码，与伊朗系统编码相同，字符ASCW代码中存在一些差异。我把我最后的一些相关问题编入了你的指南，作为答案发表。谢谢你，我欠你的。