用VB+ACCESS做excel报表结出数据
我用ado和VB写一个excel报表，调试时显示“实时错误'-2147467259(80004005)':odbc-connection to 'agm_k3' failed
我的代码如下：
Module：
Public Function ExecuteSQL(ByVal sql As String) As ADODB.Recordset
Dim mycon As ADODB.Connection
Set mycon = New ADODB.Connection
mycon.ConnectionString = ConnString
mycon.Open
Dim stokens() As String
On Error GoTo executesql_error
stokens = Split(sql)
If InStr("inser,delete,update", UCase(stokens(0))) Then
mycon.Execute sql
Else
Set rst = New ADODB.Recordset
rst.Open Trim(sql), mycon, adOpenKeyset, adLockOptimistic
Set ExecuteSQL = rst
End If
executesql_exit:
Set rst = Nothing
Set mycon = Nothing
Exit Function
executesql_error:
Resume executesql_exit 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\VB\Access_db.mdb;Persist Security Info=False
End Function
Public Function ConnString() As String
'Connstring = "provider=microsoft.jet.oledb.4.0;date source=" & App.Path & "/student_course.mdb"
ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\customized1\agm_k3.mdb;Persist Security Info=False"
End Function
form：
Dim mycon As ADODB.Connection
Dim rst As ADODB.Recordset
Private Sub CmdExcel_Click()
Dim mycon As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim ConnString As String
Dim sql As String
ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=e:\customized1\agm_k3.mdb;Persist Security Info=False"
mycon.ConnectionString = ConnString
mycon.Open
sql = "select * from qrymtrtnovr"
Set rst = ExecuteSQL(sql)
rst.Open sql, mycon, adOpenKeyset, adLockReadOnly
Dim i As Integer
Dim j As Integer
Set xlApp = New Excel.Application
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlApp.Worksheets.Add
If rst.RecordCount < 1 Then
MsgBox "no Data export!", vookonly + vbCritical, " errors!"
Exit Sub
Else
With CommonDialog1
.InitDir = App.Path
.CancelError = True
.DialogTitle = "Export DB"
.ShowSave
End With
End If
xlBook.ActiveSheet.Name = "Material Turnover Rpt"
xlSheet.Cells(1, 1) = "FYear"
xlSheet.Cells(1, 2) = "FPeriod"
xlSheet.Cells(1, 3) = "Fnumber"
xlSheet.Cells(1, 4) = "FHelpcode"
xlSheet.Cells(1, 5) = "FName"
xlSheet.Cells(1, 6) = "TurnOver"
For i = 2 To rs.RecordCount + 1
For j = 1 To rs.Fields.Count
xlSheet.Cells(i, j) = rs.Fields.Item(j - 1).Value
Next j
rs.MoveNext
Next i
End Sub
Private Sub Form_Load()
Me.BackColor = &HC000&
Me.Width = 7200
Me.Height = 5100
End Sub --------------------编程问答--------------------
ExecuteSQL()里面已经打开了,这里还要这么一句干嘛?不报错?"对象已打开"
补充：VB , 数据库(包含打印，安装，报表)
