誰能幫我搞定加100分.

Question

我想將mdb數据庫轉換成excel.word. text文件. 可是在网上找的源程序移植后都不行.
我想點激一個command后轉換成excel 或 word 或 text文件.用ADO + Datagrid.
數据庫名mydata.mdb. 數据表 table. 

Answer 1

是將mdb轉化為excel. word. text文件.

Answer 2

可能我說錯了. 我是要將mdb文件轉化成能夠用excel.word. text打開的文件.
因為公司很多電腦都沒有裝Access 2000.

Answer 3

    如果只是在你自己公司使用，建议还是装一下access，否则，你做起来会很吃力（还不讨好）。

Answer 4

1.Access将数据库数据传给Excel
Private Sub Form_Load()
     Data1.DatabaseName = App.Path & "\msdb.mdb"
     Text1.Text = Data1.DatabaseName
End Sub
Private Sub Command1_Click()
Dim i As Integer, j As Integer
Dim Newxls As Excel.Application
Dim Newbook As Excel.Workbook
Dim Newsheet As Excel.Worksheet
        Set Newxls = CreateObject("Excel.Application") '创建excel应用程序,打开excel2000
        Newxls.Visible = True
        Set Newbook = Newxls.Workbooks.Add               '创建工作簿
        Set Newsheet = Newbook.Worksheets(1)            '创建工作表
If Not Data1.Recordset.EOF Then Data1.Recordset.MoveFirst
On Error Resume Next
        For i = 0 To Data1.Recordset.RecordCount - 1
                 For j = 0 To Data1.Recordset.Fields.Count - 1
                DBGrid1.Row = i
                DBGrid1.Col = j
                 Newsheet.Cells(i + 1, j + 1) = DBGrid1.Text
    Next j
Next i
Err.Clear
End Sub
Private Sub Command2_Click()
  End
End Sub

Answer 5

你的意思，，肯定是导出估计，你也是一个初手，表达不清楚你自己到底想要干什么吧，呵呵，其实 就是做一个把ACCESS里的数据导出成一个Excel文件,对吧，这个程序太多了，楼上已经提供了。

Answer 6

Option ExplicitPrivate Sub Command1_Click()
        Dim Conn As New ADODB.Connection
        
        
        
        Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\aa.mdb"
        Conn.Open
        Conn.Execute "Select * INTO Test From [Excel 8.0;DATABASE=" & App.Path & "\bbb.xls].[Sheet1$]", , adCmdText
        
        Conn.Close
        Set Conn = Nothing
        MsgBox "OK!请您打开bbb.xls文件察看!"
End Sub

Answer 7

我剛移植樓上大俠的程序. 報錯:
Micorsoft Jet 資料庫引擎無法找到"sheet1$ ". 請确定這個物件存在..... Conn.Execute "Select * INTO Test From [Excel 8.0;DATABASE=" & App.Path & "\bbb.xls].[Sheet1$]", , adCmdText              成黃色我已經在工程中引用Microsoft Excel 9.0 object library.
還是報錯!

Answer 8

建议不使用select into导出,这会影响效率
用CopyFromRecordset　　Dim myexcel As New Excel.Application
　　Dim mybook As New Excel.Workbook
　　Dim mysheet As New Excel.Worksheet
　　Set mybook = myexcel.Workbooks.Add '添加一个新的BOOK
　　Set mysheet = mybook.Worksheets.Add '添加一个新的SHEET
　　 myexcel.visible=true
　　
　　mysheet.Cells.CopyFromRecordset myres
　　
　　mybook.SaveAs (m_ExcelName) '保存文件

Answer 9

用绑定Datagrid的Recordset导出就行了

Answer 10

又試驗了SafeF8(1+1+1>4) 大俠的程序. 眼看就快ok了. 最后還是報錯:
沒有設定物件變數或With區塊變數.
If Not Data1.Recordset.EOF Then這段成黃色.

Answer 11

象这样的程序应该很多的
基本思想是：
第一步：引用和创建Excel\Word\Html对象
第二步：打开创建的对象
第三步：通过Recordset和field对象对读数据库中的数据
第四步：把这些数据写入Excel\Word\Html中
例如 先引用Microsoft Word 10.0 object library.
Dim wdApp As Word.Application  '定义word变量
Dim wdDoc '定义word文档变量
Dim wdTable '定义WORD表格变量
Dim FieldLen()  '存放字段长度值
Dim FieldLen1 As Integer  '存放每列的最大宽度
Dim FieldValue As String
Dim iRow, iCol As Integer
Dim iRowCount, iColCount As Integer
List1.SetFocus
If MsgBox(Chr(13) + "是否转换成WORD数据？  ", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Label6.Caption = "正在转换，请稍后..."
On Error Resume Next
Data1.DatabaseName = Text1.Text‘连接数据
Data1.RecordSource = List1.Text
Data1.Refresh
With Data1.Recordset
  .MoveLast
  If .RecordCount < 1 Then
    Data1.Database.Close
    Exit Sub  '没有记录时退出
  End If
  iRowCount = .RecordCount + 1 '记录总数
  iColCount = .Fields.Count  '字段总数
  .MoveFirst
End With
'重新定义列数
ReDim FieldLen(iColCount)
'添加一个word文档及表
Set wdApp = CreateObject("Word.Application")’创建对象
Set wdDoc = wdApp.Documents.Add
Set wdTable = wdApp.Selection.Tables.Add(wdApp.Selection.Range, iRowCount, iColCount, wdWord9TableBehavior, wdAutoFitFixed)
'生成word
With Data1.Recordset
  '读取标题宽度作为列宽初始值
  For iCol = 1 To iColCount
    FieldLen(iCol) = LenB(StrConv(.Fields(iCol - 1).Name, vbFromUnicode))
  Next iCol
  For iRow = 1 To iRowCount
    For iCol = 1 To iColCount
      '读取字段值，返回为文本型
      If .Fields(iCol - 1).Type = 10 Then
        FieldValue = Trim(.Fields(iCol - 1).Value)
      Else
        FieldValue = CStr(.Fields(iCol - 1).Value)
      End If
      Select Case iRow
      Case 1  '在表中的第一行加标题
        wdTable.Cell(iRow, iCol).Range.InsertAfter (.Fields(iCol - 1).Name)  'Word表
      Case Else
        '计算字段值长度，返回值的单位是字节长度
        FieldLen1 = LenB(StrConv(FieldValue, vbFromUnicode))
        '自动设置表格列宽
        If FieldLen(iCol) < FieldLen1 Then
          '表格列宽等于较长字段长
          wdTable.Columns(iCol).PreferredWidth = 8 * FieldLen1 'Word表
          '数组Fieldlen(iCol)中存放最大字段长度值
          FieldLen(iCol) = FieldLen1
        Else
          '表格列宽等于当前字段宽度
          wdTable.Columns(iCol).PreferredWidth = 8 * FieldLen(iCol)  'Word表
        End If
        '向表单元格中写入字段值
        wdTable.Cell(iRow, iCol).Range.InsertAfter (FieldValue) 'Word表
      End Select
      DoEvents
    Next iCol
    If iRow <> 1 Then
      If Not .EOF Then .MoveNext
    End If
    DoEvents
  Next iRow
  Data1.Database.Close  '关闭数据库
  wdApp.Visible = True  '显示Word表格
  Set wdApp = Nothing  '交还控制给Word
End With
End Sub

Answer 12

胜利在望了.我用小強的程序.將mysheet.Cells.CopyFromRecordset myres.中的myres改成我程序中的Adodc1.recordset.已經可以導出excel數据了.可是還是提示報錯.
錯誤代碼:1004
檔案無法存取.請确定以下几件事情是否正确.
.确定所指的檔案是否存在.
.确定檔案不是唯讀
.确定檔案名稱不包含<> ? [] : *
.确定檔案名稱或路徑不超過218個位元組.离胜利不過一步之遙了. 大家幫我想想辦法啊. 還有就是如何導出text 文件?

Answer 13

to: zrguang(左轮) 
謝謝您的程序.
例如 先引用Microsoft Word 10.0 object library.
Dim wdApp As Word.Application  '定义word变量
-----------------------------------------------
我的vb只有Microsoft word 9.0 object library.可以嗎?
為何我在定義word變量時候. 不能的到word.后面的屬性?

Answer 14

怎么數据表的field不能顯示出來呢?

Answer 15

是导出数据啊。不会把FIELD字段也导出的。

Answer 16

現在導出到excel已經成功了. word還有點問題. zrguang(左轮)能否再賜教?
text導出是否簡單一寫?