将所有表导出为具有导出规范的txt文件

时间:2016-11-04 11:38:42

标签: ms-access access-vba

我有一个包含几个不同表的Access数据库,每个表都有不同的结构(数字和字段名称,行数,标题)。

我想要做的是将所有这些表导出到txt文件中,使用给定的分隔符(" |"),指向小数点分隔符,为字符串引用。

我浏览过互联网,得到的是:

  • 使用DoCmd.TransferText acExportDelim命令
  • 保存自定义导出规范并应用

我得到一个错误信息("对象不存在")我认为这与导出规范是特定于表单的事实有关,即不适用到具有不同字段和字段名的表。

你能帮帮我吗? 谢谢!

EDIT。 我也发布了我运行的原始代码。正如我之前所说,我是VBA的新手,所以我只是在网上寻找代码,根据我的需要进行调整,然后运行。

Public Sub ExportDatabaseObjects()
On Error GoTo Err_ExportDatabaseObjects

Dim db As Database
Dim db As DAO.Database
Dim td As TableDef
Dim sExportLocation As String
Dim a As Long

Set db = CurrentDb()

sExportLocation = "C:\" 'Do not forget the closing back slash! ie: C:\Temp\

For a = 0 To db.TableDefs.Count - 1
    If Not (db.TableDefs(a).Name Like "MSys*") Then
        DoCmd.TransferText acExportDelim, "Export_specs",  db.TableDefs(a).Name, sExportLocation & db.TableDefs(a).Name & ".txt", True
    End If
Next a

Set db = Nothing

MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation

Exit_ExportDatabaseObjects:
Exit Sub

Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects

End Sub

在运行代码之前,我手动导出第一个表,将Export_specs保存到文件中。

考虑一个带有两个表A和B的数据库。 当我运行代码A被正确导出时,我得到以下错误消息" 3011 - Microsoft Access数据库引擎找不到对象' B#txt'。确保对象存在,并且您正确拼写其名称和路径名称。如果' B#txt'不是本地对象,请检查您的网络连接或联系服务器管理"。

1 个答案:

答案 0 :(得分:1)

所以,它有点复杂。我已经创建了一个使用ImportExport规范导入文件的例程,您应该能够轻松地适应您的目的。基本操作是创建一个完全符合您想要的文件的规范。然后,使用以下代码导出此规范:

Public Function SaveSpecAsXMltoTempDirectory(sSpecName As String)

Dim oFSO As FileSystemObject
Dim oTS As TextStream

Set oFSO = New FileSystemObject
Set oTS = oFSO.CreateTextFile("C:\Temp\" & sSpecName & ".xml", True)
oTS.Write CurrentProject.ImportExportSpecifications(sSpecName).XML

oTS.Close
Set oTS = Nothing
Set oFSO = Nothing

End Function

然后在记事本中打开此文件,并用一些占位符替换文件名(我在此示例中使用了“FILE_PATH_AND_NAME”)。然后,使用以下代码导入回数据库:

Public Function SaveSpecFromXMLinTempDirectory(sSpecName As String)

Dim oFSO As FileSystemObject
Dim oTS As TextStream
Dim sSpecXML As String
Dim oSpec As ImportExportSpecification

Set oFSO = New FileSystemObject
Set oTS = oFSO.OpenTextFile("C:\Temp\" & sSpecName & ".xml", ForReading)
sSpecXML = oTS.ReadAll
For Each oSpec In CurrentProject.ImportExportSpecifications
    If oSpec.Name = sSpecName Then oSpec.Delete
Next oSpec
Set oSpec = CurrentProject.ImportExportSpecifications.Add(sSpecName, sSpecXML)

Set oSpec = Nothing
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing

End Function

现在您可以循环访问文件并使用文件名替换规范中的占位符,然后使用以下代码执行它:

Public Function ImportFileUsingSpecification(sSpecName As String, sFile As String) As Boolean

Dim oSpec As ImportExportSpecification
Dim sSpecXML As String
Dim bReturn As Boolean

'initialize return variable as bad until function completes
bReturn = False
'export data using saved Spec
'   first make sure no temp spec left by accident
For Each oSpec In CurrentProject.ImportExportSpecifications
    If oSpec.Name = "Temp" Then oSpec.Delete
Next oSpec
sSpecXML = CurrentProject.ImportExportSpecifications(sSpecName).XML
If Not Len(sSpecXML) = 0 Then
    sSpecXML = Replace(sSpecXML, "FILE_PATH_AND_NAME", sFile)
    'now create temp spec to use, get template text and replace file path and name
    Set oSpec = CurrentProject.ImportExportSpecifications.Add("Temp", sSpecXML)
    oSpec.Execute
    bReturn = True
Else
    MsgBox "Could not locate correct specification to import that file!", vbCritical, "NOTIFY ADMIN"
    GoTo ExitImport
End If

ExitImport:
    On Error Resume Next
    ImportFileUsingSpecification = bReturn
    Set oSpec = Nothing
    Exit Function
End Function

显然,您需要在规范XML中找到表名,并在其上使用占位符。如果你不能让它工作,请告诉我,我会更新出口。