VB中Access数据表导出到Excel，都是2007版

[zzpyt]

Private Sub cmdout_Click()

Dim rst As New ADODB.Recordset
rst.Open "select" & Left(Trim(Text1.Text), Len(Trim(Text1.Text)) - 1) & "from" & combo1.Text & "", cn1, adOpenDynamic, adLockOptimistic

Dim xlsApp As Excel.Application '定义Excel程序
Dim xlsBook As Excel.Workbook '定义工作薄
Dim xlsSheet As Excel.Worksheet '定义工作表
Dim i, j As Long
Set xlsApp = CreateObject("Excel.Application")
'创建Excel应用程序
Set xlsBook = xlsApp.Workbooks.Add '创建工作薄
Set xlsSheet = xlsBook.Worksheets(1) '创建工作表
On Error Resume Next
j = 1
Do Until rst.EOF
For i = 1 To rst.Fields.Count
xlsSheet.Cells(j, i) = rst.Fields(i - 1)
'写入记录集（不包括表头）
Next i
rst.MoveNext
j = j + 1
Loop
xlsApp.Visible = True '显示电子表格
xlsBook.SaveAs App.Path & "\导出数据.xlsx"
Set xlsApp = Nothing '交换控制权给Excel
rst.Close
cn1.Close
Set rst = Nothing
Set cn1 = Nothing
Unload Me
Unload fm

End Sub

Private Sub combo1_Click() '向列表框添加表的字段名称
Dim i As Integer
Dim srs As New ADODB.Recordset
list1.Clear
srs.Open combo1.Text, cn1, adOpenKeyset, adLockOptimistic
i = srs.Fields.Count
For i = 0 To srs.Fields.Count - 1
list1.AddItem srs.Fields(i).Name
Next i
srs.Close
Set srs = Nothing

End Sub

Private Sub img1_Click() '选择文件向组合框添加记录

Dim rs1 As New ADODB.Recordset
cmd00.Filter = "Access文件（*.accdb）|*.accdb|所有文件（*.*）|*.*"
cmd00.CancelError = True
cmd00.DialogTitle = "打开Access文件"
cmd00.ShowOpen
fn = cmd00.FileName
Text1 = cmd00.FileName

If fn = "" Then
MsgBox "请重新选择Access文件！", vbInformation + vbOKOnly
End If
If cn1.State = adStateOpen Then
cn1.Close
combo1.Clear
End If
Call accdbcon
Set rs1 = cn1.OpenSchema(adSchemaTables)
Do Until rs1.EOF
If Left(rs1!table_name, 4) <> "MSys" Then '过滤系统文件名
combo1.AddItem rs1!table_name
End If
rs1.MoveNext
Loop
rs1.Close
Set rs1 = Nothing
End Sub

Private Sub list1_ItemCheck(Item As Integer)

Text1.Text = Text1.Text & list1.List(Item) & ","
'把list1所选的字段赋给text1文本框
cmdout.Enabled = True

End Sub



问题
1、想导出的是整个表 而不是表中的一个字段
2、报错怎么解决 调试语句是这句
rst.Open "select" & Left(Trim(Text1.Text), Len(Trim(Text1.Text)) - 1) & "from" & combo1.Text & "", cn1, adOpenDynamic, adLockOptimistic

[Tiger_Zhao]

Debug.Print "select" & Left(Trim(Text1.Text), Len(Trim(Text1.Text)) - 1) & "from" & combo1.Text & ""

什么内容？

[zzpyt]

引用 1 楼 Tiger_Zhao 的回复:

Debug.Print "select" & Left(Trim(Text1.Text), Len(Trim(Text1.Text)) - 1) & "from" & combo1.Text & ""

什么内容？

谢谢你啊 这个问题已经解决了 程序还没做完 后期还会有问题 到时再求助于您吧

[zzpyt]

引用 1 楼 Tiger_Zhao 的回复:

Debug.Print "select" & Left(Trim(Text1.Text), Len(Trim(Text1.Text)) - 1) & "from" & combo1.Text & ""

什么内容？

下面代码是想实现查询的功能，但是窗体打开时弹出adodc1提示框 说至少一个参数没有被制定值
Private Sub Cmd_Yes_Click()
If Combo_gcmc.Text = "" Then
MsgBox "请选择工程名称"
End If
If Combo_sjxx.Text = Protocol Then
FrmProtocol.Show 0, Me
ElseIf Combo_sjxx.Text = Strokedata Then
FrmStrokedata.Show 0, Me
ElseIf Combo_sjxx.Text = 打桩记录 Then
Frm打桩记录.Show 0, Me
ElseIf Combo_sjxx.Text = 工程桩信息 Then
Frm工程桩信息.Show 0, Me
ElseIf Combo_sjxx.Text = 轴向承载力设计参数 Then
Frm轴向承载力设计参数.Show 0, Me
Else
MsgBox "请选择数据选项"
End If
End Sub

Private Sub RefreshData()
'设置数据源
Adodc1.ConnectionString = conn
Adodc1.RecordSource = "SELECT PF_name from 工程编号 "
Adodc1.Refresh
End Sub

Private Sub Cmd_Back_Click()
Unload Me
End Sub

Private Sub Form_Load()
'Dim conn As New ADODB.Connection
'设置记录源
Adodc1.ConnectionString = conn
Adodc1.RecordSource = "SELECT * FROM 工程编号 where PF_name order by Project_ID"
Adodc1.Refresh
End Sub

请问是不是conn没有被定义，加Dim conn As New ADODB.Connection 能解决问题吗

[zzpyt]

引用 1 楼 Tiger_Zhao 的回复:

Debug.Print "select" & Left(Trim(Text1.Text), Len(Trim(Text1.Text)) - 1) & "from" & combo1.Text & ""

什么内容？

conn在标准模块里已经被定义为字符串了 全局变量 那报错是什么原因呢？

[Tiger_Zhao]

SELECT * FROM 工程编号 where PF_name order by Project_ID

[zzpyt]

引用 5 楼 Tiger_Zhao 的回复:

SELECT * FROM 工程编号 where PF_name order by Project_ID

是PF_name="datacombo1.listfield"吗？ datacombo1控件下拉之后也没有内容 是什么原因呢 在该控件的属性中都已经选择datasource和rowsource都是adodc1了 难道还没连接上吗

[Tiger_Zhao]

你这个SQL有错啊，先把SQL写正确。

[zzpyt]

Access导入到Excel中，如果Excel工作薄已经存在同名的导出表，怎么判断并覆盖原表或者在原表基础上添加新数据

[zzpyt]

引用 7 楼 Tiger_Zhao 的回复:

你这个SQL有错啊，先把SQL写正确。

这个问题昨天解决了 谢谢啊 新问题是：Access导入到Excel中，如果Excel工作薄已经存在同名的导出表，怎么判断并覆盖原表或者在原表基础上添加新数据

[Tiger_Zhao]

设置 Excel 的 Application.DisplayAlerts = False，WorkBook.SaveAs 就能直接覆盖文件进行保存。