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
uj5u.com熱心網友回復：
Debug.Print "select" & Left(Trim(Text1.Text), Len(Trim(Text1.Text)) - 1) & "from" & combo1.Text & ""
什么內容？
uj5u.com熱心網友回復：
謝謝你啊 這個問題已經解決了 程式還沒做完 后期還會有問題 到時再求助于您吧
uj5u.com熱心網友回復：
下面代碼是想實作查詢的功能，但是表單打開時彈出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 能解決問題嗎
uj5u.com熱心網友回復：
conn在標準模塊里已經被定義為字串了 全域變數 那報錯是什么原因呢？
uj5u.com熱心網友回復：
SELECT * FROM 工程編號 where PF_name order by Project_IDuj5u.com熱心網友回復：
是PF_name="datacombo1.listfield"嗎？
datacombo1控制元件下拉之后也沒有內容 是什么原因呢 在該控制元件的屬性中都已經選擇datasource和rowsource都是adodc1了 難道還沒連接上嗎
uj5u.com熱心網友回復：
你這個SQL有錯啊，先把SQL寫正確。uj5u.com熱心網友回復：
Access匯入到Excel中，如果Excel作業薄已經存在同名的匯出表，怎么判斷并覆寫原表或者在原表基礎上添加新資料uj5u.com熱心網友回復：
這個問題昨天解決了 謝謝啊
新問題是：Access匯入到Excel中，如果Excel作業薄已經存在同名的匯出表，怎么判斷并覆寫原表或者在原表基礎上添加新資料
uj5u.com熱心網友回復：
設定 Excel 的 Application.DisplayAlerts = False，WorkBook.SaveAs 就能直接覆寫檔案進行保存。轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/105140.html