为什么我原来用的好好的程序代码在我增加了两个按钮添了两个功能后出错了？有没有可能是什么冲突啊？
EMMBKlml.rar我建的整个工程都在附件里，大家下下来耐心看下了，我就是在加了 查看基础课程 和 查看 课程设计与实践类课程这两个功能后出错了，我没加之前是完全能用的 ，呵呵，就是里面代码和窗体建的有点乱
Private Sub CreateDatabase(mdbPath, mdbPassword)
Dim cat As New ADOX.Catalog
If mdbPassword = "" Then
cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Password=;Data Source" & mdbPath & ";"
Else
cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source = " & mdbPath & ";"
End If '这句说有自动化错误，之前用的好好的啊
End Sub
Private Sub daoru(sTableName As String, appdisk As String)
Dim tempDB As Database
Dim i As Integer ' 循环计数器
Dim j As Integer
Dim rCount As Long ' 记录的个数
Dim xl As Object ' OLE自动化对象
Dim Sn As Recordset
Dim dbName As String
If Right(SavePath, 1) <> "\" Then
SavePath = SavePath & "\"
End If
dbName = appdisk & "考场安排.mdb"
Screen.MousePointer = 11
'Label1.Caption = "打开数据库..."
'Label1.Refresh
Set tempDB = Workspaces(0).OpenDatabase(dbName) '生成工程1.exe时说ActiveX部件不能创建对象
'Label1.Caption = "创建Excel对象..."
'Label1.Refresh
Set xl = CreateObject("Excel.Sheet.8")
'Label1.Caption = "创建快照型记录集..."
'Label1.Refresh
Set Sn = tempDB.OpenRecordset(sTableName, dbOpenSnapshot)
If Sn.RecordCount > 0 Then
'Label1.Caption = "将字段名添加到电子表格中"
'Label1.Refresh
For i = 0 To Sn.Fields.Count - 1
xl.Worksheets(1).Cells(1, i + 1).Value = Sn(i).Name
Next
Sn.MoveLast
Sn.MoveFirst
rCount = Sn.RecordCount
' 在记录中循环
i = 0
Do While Not Sn.EOF
Label1.Caption = "导出表" & sTableName & "------------------" & (i + 1) * 100 \ rCount & "%"
Label1.Refresh
For j = 0 To Sn.Fields.Count - 1
' 加每个字段的值加到工作表中
If Sn(j).Type < 11 Then
xl.Worksheets(1).Cells(i + 2, j + 1).Value = Sn(j)
Else
' 处理Memo和LongBinary 类型的字段
xl.Worksheets(1).Cells(i + 2, j + 1).Value = "Memo or Binary Data"
End If
Next j
Sn.MoveNext
i = i + 1
Loop
' 保存工作表
'Label1.Caption = "保存文件..."
'Label1.Refresh
xl.SaveAs SavePath & "\" & sTableName
'从内存中删除Excel对象
'Label1.Caption = "退出Excel"
'Label1.Refresh
xl.Application.Quit
Else
' 没有记录
End If
' 清除
'Label1.Caption = "清除对象"
'Label1.Refresh
Set xl = Nothing
Set Sn = Nothing
Set tempDB = Nothing
Screen.MousePointer = 0 ' 恢复鼠标指针
Label1.Caption = "Ready"
Label1.Refresh
End Sub
[此贴子已经被作者于2007-10-27 17:04:42编辑过]
