可以使用VBA代码从Access导出数据至文本文件吗

可以使用VBA代码从Access导出数据至文本文件吗

在工具-引用中选择macrosoft ActiveX Data Objects
Private Sub CommandButton1_Click() '以output打开方式
Application.ScreenUpdating = False
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim arrTable() As String
Dim i As Long
i = 0
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
With conn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\" & "01.mdb" '数据库名称自己修改
.Open
End With
Set rs = conn.OpenSchema(adSchemaTables)
rs.MoveFirst
While rs.EOF = False
If rs.Fields("Table_Type").Value = "TABLE" Then
ReDim Preserve arrTable(i)
arrTable(i) = rs.Fields("Table_name").Value
i = i + 1
End If
rs.MoveNext
Wend
If i = 0 Then
MsgBox "no table in database"
Exit Sub
End If
rs.Close
Dim j As Long
Dim strTemp As String
For j = 0 To UBound(arrTable)
strTemp = ""
rs.Open "select * from " & arrTable(j), conn, 3, 1
If rs.RecordCount < 1 Then
MsgBox "no record in table " & arrTable(j)
else
Open ActiveWorkbook.Path & "\" & arrTable(j) & ".txt" For Output As #1
For i = 0 To rs.Fields.Count - 1
strTemp = strTemp & rs.Fields(i).Name & "|"
Next
Print #1, Left(strTemp, Len(strTemp) - 1) & Chr(13)
rs.MoveFirst

While rs.EOF = False
strTemp = ""
For i = 0 To rs.Fields.Count - 1
strTemp = strTemp & rs.Fields(i).Value & "|"
Next
Print #1, Left(strTemp, Len(strTemp) - 1) & Chr(13)
rs.MoveNext
Wend
Close #1
end if
Next
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
End Sub

可以的 没问题 我能写

可以，有多种方法给你一个最简单的 生成的文件以；分隔各字段 Sub SaveToFile() Dim tabelName As String Dim Rst tabelName = "你的表名" Set Rst = CreateObject("ADODB.Recordset") Rst.Open tabelName, CurrentProject.Connection CreateObject("scripting.filesystemobject").CreateTextFile("c:\" & tabelName & ".txt").Write Rst.GetString(adClipString, -1, ";", vbCrLf) Rst.Close Set Rst = Nothing End Sub

在工具-引用中选择macrosoft ActiveX Data Objects Private Sub CommandButton1_Click() '以output打开方式 Application.ScreenUpdating = False Dim conn As ADODB.Connection Dim rs As ADODB.Recordset Dim arrTable() As String Dim i As Long i = 0 Set conn = New ADODB.Connection Set rs = New ADODB.Recordset With conn .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\" & "01.mdb" '数据库名称自己修改 .Open End With Set rs = conn.OpenSchema(adSchemaTables) rs.MoveFirst While rs.EOF = False If rs.Fields("Table_Type").Value = "TABLE" Then ReDim Preserve arrTable(i) arrTable(i) = rs.Fields("Table_name").Value i = i + 1 End If rs.MoveNext Wend If i = 0 Then MsgBox "no table in database" Exit Sub End If rs.Close Dim j As Long Dim strTemp As String For j = 0 To UBound(arrTable) strTemp = "" rs.Open "select * from " & arrTable(j), conn, 3, 1 If rs.RecordCount < 1 Then MsgBox "no record in table " & arrTable(j) else Open ActiveWorkbook.Path & "\" & arrTable(j) & ".txt" For Output As #1 For i = 0 To rs.Fields.Count - 1 strTemp = strTemp & rs.Fields(i).Name & "|" Next Print #1, Left(strTemp, Len(strTemp) - 1) & Chr(13) rs.MoveFirst While rs.EOF = False strTemp = "" For i = 0 To rs.Fields.Count - 1 strTemp = strTemp & rs.Fields(i).Value & "|" Next Print #1, Left(strTemp, Len(strTemp) - 1) & Chr(13) rs.MoveNext Wend Close #1 end if Next rs.Close conn.Close Set rs = Nothing Set conn = Nothing End Sub