Question

用VB将Access中的某几列数据导入到excel当中？

VB窗体有有添加记录的按钮，已实现对Access数据库的增删。想要同事把每次更新的数据库导入到excel当中可进行查询，网上的代码调了半天都不行。求高手写下这部分的代码，感激不尽！

Answer 1

给你一段代码，修改下即可！
第一步：创建一个Excel的链接表！
'输入目录向数据库链接一个Excel表 并且加上 "XL"
Sub LinkInxlsData(strSelectDir As String, tabName As String)
On Error GoTo Err_InExcel

Dim rst1 As ADODB.Recordset
Dim cat1 As New ADOX.Catalog
Dim tbl1 As ADOX.Table
Dim strXLtab As String

strXLtab = "XL" & tabName

cat1.ActiveConnection = CurrentProject.Connection
For Each tbl1 In cat1.Tables
If tbl1.Name = strXLtab Then
cat1.Tables.Delete (strXLtab)
End If
Next tbl1
'链接这个Excel表
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel97, strXLtab, strSelectDir, -1, tabName
Application.RefreshDatabaseWindow

Exit_InExcel:
Exit Sub
Err_InExcel:
MsgBox "在你指定的目录下没有你要找的文件，请重新选择路径！", vbExclamation, "迈和瑞软件提示 导入错误"
Resume Exit_InExcel
End Sub

'删除一个指定的链接表
Sub DelLinkAccTable(tabName As String)
Dim cat1 As New ADOX.Catalog
Dim tbl1 As ADOX.Table

cat1.ActiveConnection = CurrentProject.Connection
For Each tbl1 In cat1.Tables
If tbl1.Name = tabName Then
cat1.Tables.Delete (tabName)
End If
Next tbl1
Application.RefreshDatabaseWindow
End Sub

第二步：连接好后，调用这个函数，追加数据到目标表
'链接一个表然后追加数据到当前数据库的表
Sub LinkAddAccDataTomyDB(mystrdir As String, inputTab As String)

Dim myTab As String, myMDBtab As String
Dim strSQL As String

myTab = inputTab
myMDBtab = "MDB" & inputTab
'Debug.Print mystrdir, mytab
'链接这个Excel表
LinkAccessTable mystrdir, myTab
'追加数据
strSQL = "INSERT INTO " & "[" & myTab & "]" & " SELECT " & "[" & myMDBtab & "]" & ".* FROM " & "[" & myMDBtab & "]" & ";"
'Debug.Print strSQL
Call MeExecuteSQL(strSQL)

'删除链接表
DelLinkAccessTable myMDBtab

'MsgBox "数据导入成功！", vbInformation, AccMsgTitl
End Sub

最后：导入完成，用上面删除链接表的程序删除链接表！
yszhongsoft@163.com