如何创建dBase(IV?)文件?

时间:2013-06-07 13:49:16

标签: vba excel-vba ms-access-2007 syntax-error dbase

我正在尝试创建一个dBase文件,因为我的Export vba代码中的.TransferDatabase()方法似乎要求文件存在(继续“字段不适合记录”。假设由于文件不存在)。

我使用vba在线找到了一种方法:

http://edndoc.esri.com/arcobjects/8.3/samples/geodatabase/creating%20data/createnewdbf.htm

Public Function createDBF(strName As String, _
                      strFolder As String, _
             Optional pFields As IFields) As ITable
' createDBF: simple function to create a DBASE file.
' note: the name of the DBASE file should not contain the .dbf extension
'
On Error GoTo EH

' Open the Workspace
Dim pFWS As IFeatureWorkspace
Dim pWorkspaceFactory As IWorkspaceFactory
Dim fs as object
Dim pFieldsEdit As esriCore.IFieldsEdit
Dim pFieldEdit As esriCore.IFieldEdit
Dim pField As IField

Set pWorkspaceFactory = New ShapefileWorkspaceFactory
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FolderExists(strFolder) Then
MsgBox "Folder does not exist: " & vbCr & strFolder
Exit Function
End If

Set pFWS = pWorkspaceFactory.OpenFromFile(strFolder, 0)

  ' if a fields collection is not passed in then create one
If pFields Is Nothing Then
' create the fields used by our object
Set pFields = New esriCore.Fields
Set pFieldsEdit = pFields
pFieldsEdit.FieldCount = 1

'Create text Field
Set pField = New Field
Set pFieldEdit = pField
With pFieldEdit
    .Length = 30
    .Name = "TextField"
    .Type = esriFieldTypeString
End With
Set pFieldsEdit.Field(0) = pField
End If

Set createDBF = pFWS.CreateTable(strName, pFields, Nothing, Nothing, "")

Exit Function
EH:
    MsgBox Err.Description, vbInformation, "createDBF"

End Function

但是当试图运行它只是为了测试下面的行时收到“编译错误:用户定义的类型未定义”:

Public Function createDBF(strName As String, _
                      strFolder As String, _
             Optional pFields As IFields) As ITable

另一个帖子(2003年......)建议可以使用查询将我的访问表导出到dBase文件:

http://www.pcreview.co.uk/forums/creating-dbf-file-using-access-vba-code-t1077674.html

但我的语法似乎已关闭,收到“查询中的语法错误。不完整的查询条款:

SELECT ImportedData.*
INTO "...filePath\Personal Project Notes\" "dBase IV;"
FROM ImportedData;

如果有人有任何想法来解决这些问题甚至是不同的解决方案我都会听到。再次,尝试创建dBase文件,因为我的以下导出代码标记.TransferDatabase()方法说“字段将不适合记录”:

导出代码:

Sub Export()
Dim dbConnection As ADODB.Connection
Dim dbFileName As String
Dim dbRecordset As ADODB.Recordset
Dim xRow As Long, xColumn As Long
Dim LastRow As Long

'Go to the worksheet containing the records you want to transfer.
Worksheets("FeedSamples").Activate
'Determine the last row of data based on column A.
LastRow = Cells(Rows.Count, 1).End(xlUp).row
'Create the connection to the database.
Set dbConnection = New ADODB.Connection
'Define the database file name
dbFileName = "...filePath\Personal Project Notes\FeedSampleResults.accdb"
'Define the Provider and open the connection.
With dbConnection
    .Provider = "Microsoft.ACE.OLEDB.12.0;Data Source=" & dbFileName & _
    ";Persist Security Info=False;"
    .Open dbFileName
End With
'Create the recordset
Set dbRecordset = New ADODB.Recordset
dbRecordset.CursorLocation = adUseServer
dbRecordset.Open Source:="ImportedData", _
ActiveConnection:=dbConnection, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable
'Loop thru rows & columns to load records from Excel to Access.
'Assume row 1 is the header row, so start at row 2.
'ACCESS COLUMNS MUST BE NAMED EXACTLY THE SAME AS EXCEL COLUMNS
For xRow = 2 To LastRow
    dbRecordset.AddNew
    'Assume this is an 8-column (field) table starting with column A.
    For xColumn = 1 To 69
        dbRecordset(Cells(1, xColumn).value) = Cells(xRow, xColumn).value
    Next xColumn
    dbRecordset.Update
Next xRow

'Close the connections.
dbRecordset.Close
dbConnection.Close
'Release Object variable memory.
Set dbRecordset = Nothing
Set dbConnection = Nothing
'Optional:
'Clear the range of data (the records) you just transferred.
'Range("A2:H" & LastRow).ClearContents
MsgBox "Test"

Dim acx As access.Application
Set acx = New access.Application
acx.OpenCurrentDatabase ("...filePath\Personal Project Notes\FeedSampleResults.accdb")
acx.DoCmd.TransferDatabase acExport, "dBase IV", "...filePath\Personal Project Notes\", acTable, "ImportedData", "TEST.DBF"
acx.CloseCurrentDatabase


End Sub

文件路径是正确的,但目前TEST.DBF不存在。我最初假设该方法为我创建了文件...

修改

经过一些测试后,我将Access表缩小到了15个字段,TEXT为255个字符。运行Access gui-Export时,我成功地创建了包含15个字段的dBase IV文件。因为我有了我的.DBF文件,所以我把它放在我的.TransferDatabase()文件路径中,我在Excel中的vba代码从Excel成功执行到访问dBase文件!

我现在只需要弄清楚出口69条记录与15条记录时的问题....

有什么想法吗?

1 个答案:

答案 0 :(得分:1)

以下过程适用于Access 2010.

我保留了一个名为C:\__tmp\的工作目录,用于搞乱事情。我创建了一个名为dbfTest的新子文件夹,它以空白开头:

C:\__tmp\dbfTest>dir
 Volume in drive C has no label.
 Volume Serial Number is 2A3E-1929

 Directory of C:\__tmp\dbfTest

2013-06-07  10:49    <DIR>          .
2013-06-07  10:49    <DIR>          ..
               0 File(s)              0 bytes
               2 Dir(s)  305,532,461,056 bytes free

然后我在Access中运行以下VBA代码将我的“客户端”表导出到“CLIENTS.DBF”

Sub dbfExportTest()
DoCmd.TransferDatabase acExport, "dBase IV", "C:\__tmp\dbfTest\", acTable, "Clients", "CLIENTS"
End Sub

完成后,我的dbfTest文件夹包含以下内容:

C:\__tmp\dbfTest>dir
 Volume in drive C has no label.
 Volume Serial Number is 2A3E-1929

 Directory of C:\__tmp\dbfTest

2013-06-07  10:55    <DIR>          .
2013-06-07  10:55    <DIR>          ..
2013-06-07  10:55             5,942 CLIENTS.DBF
2013-06-07  10:55               863 CLIENTS.DBT
2013-06-07  10:55                59 CLIENTS.INF
2013-06-07  10:55             6,144 CLIENTS.MDX
               3 File(s)         12,145 bytes
               2 Dir(s)  305,532,440,576 bytes free

Access中的My [Clients]表具有以下结构:

FieldName  Type
---------  ----------
ID         AutoNumber
LastName   Text(255)
FirstName  Text(255)
Email      Text(255)
Selection  Yes/No
intCol     Number(Long Integer)
dtmCol     Date/Time
Comments   Memo

编辑重新评论

dBASE_III和dBASE_IV文件的最大记录长度显然为4,000字节(参考:here)。这表明dBASE_IV文件不能容纳超过15个文本(254)字段。可能的解决方法包括:

  • 如果未使用全部255个字符,则更改Access中的表格结构以缩短文本(255)字段,或

  • 在导出之前将Text()字段转换为Memo,因为dBASE与Access一样,只存储主表中Memo字段的链接(dBASE为10字节)。