如何创建 dbf 文件，并在记事本中定义编码，或 VBA
How can creating dbf file, and define encoding in Notepad, or VBA
什么是DBF4 (dBase IV)(*.dbf)文件的基本格式？以及如何在与 Notepad 相同的文字编辑器中通过键入创建这些文件？（更新：，或 excel VBA？）
格式规范是什么：
Delimiter（等同于：, 或 tab 等）Separator（可能同上！）（如果这两个不是同义词）Row End 字符：（与vbCrLf相同）- 正在定义 headers 列（字段）。
Code-Page of encoding：（等同于：Unicode - 1256 等）- 和其他人...
请提供一种创建此 DB 文件格式的算法，该算法使我们能够通过创建文本文件的 VBA 方法轻松创建相同的文件。
（更新 或使用 built-in 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的编码？
关于需要的编码，比较常见的是本期的伊朗系统编码。
如何将 suitable 编码为 Iran System 的数据存储在数据库 table 记录中？
我们很开心....哈哈
此测试代码根据 excel 工作表
中的数据创建一个 dbf 文件
创建一个table并插入一条记录
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 .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 转换为伊朗系统编码的问题在于，任何字母的书写方式都完全不同，具体取决于它在单词中的位置。大多数字母有 "isolated"、"initial"、"medial" 和 "final" 形式。
这就像类固醇的大写和小写...哈哈
参考：https://www.math.nmsu.edu/~mleisher/Software/csets/IRANSYSTEM.TXT
因此在存储到数据库之前，需要额外的过程将 excel 中的 unicode 文本转换为等效的伊朗系统编码字符串。
该代码创建一个 table 具有一个文本字段并存储 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
'
什么是DBF4 (dBase IV)(*.dbf)文件的基本格式？以及如何在与 Notepad 相同的文字编辑器中通过键入创建这些文件？（更新：，或 excel VBA？）
格式规范是什么：
Delimiter（等同于：,或tab等）Separator（可能同上！）（如果这两个不是同义词）Row End字符：（与vbCrLf相同）- 正在定义 headers 列（字段）。
Code-Pageofencoding：（等同于：Unicode - 1256等）- 和其他人...
请提供一种创建此 DB 文件格式的算法，该算法使我们能够通过创建文本文件的 VBA 方法轻松创建相同的文件。
（更新 或使用 built-in 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的编码？
关于需要的编码，比较常见的是本期的伊朗系统编码。
如何将 suitable 编码为 Iran System 的数据存储在数据库 table 记录中？
我们很开心....哈哈
此测试代码根据 excel 工作表
中的数据创建一个 dbf 文件创建一个table并插入一条记录
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 .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 转换为伊朗系统编码的问题在于，任何字母的书写方式都完全不同，具体取决于它在单词中的位置。大多数字母有 "isolated"、"initial"、"medial" 和 "final" 形式。
这就像类固醇的大写和小写...哈哈
参考：https://www.math.nmsu.edu/~mleisher/Software/csets/IRANSYSTEM.TXT
因此在存储到数据库之前，需要额外的过程将 excel 中的 unicode 文本转换为等效的伊朗系统编码字符串。
该代码创建一个 table 具有一个文本字段并存储 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
'