我用VB 将数据库数据存入EXCEL为什么不能保存？
excel里用VBA写了程序的，帮看看什么问题，
在表格中直接写入数据点保存也不行，请熟悉EXCEL表格的帮我看看，
是不是VBA中有什么设定，该如何处理？
如果是EXCEL表格有限制要添加什么句子？
测试窗体添加控件：CommonDialog1一个
                 DTPicker1日期控件2个
                 command一个

导入数据库的句子我是这样写的
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sql As String
Private Sub Form_Load()
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
End Sub

Private Sub Command1_Click()
导入表格
End Sub

Sub 导入表格()
    If cn.State = adStateOpen Then cn.Close
    If rs.State = adStateOpen Then rs.Close
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\AAA.mdb;Persist Security Info=False;Jet OLEDB:Database Password=1234;"
    sql = "select * from 维修记录 where 维修日期 between #" & DTPicker1.value & "# and #" & DTPicker2.value & "# order by 维修日期 asc"
    rs.Open sql, cn, 3, 3
    If rs.RecordCount = 0 Then
       MsgBox "没有数据记录", 48, "提示："
       Exit Sub
    End If
    '上面是先查询数据库数据，按时间查询符合条件的数据
    '----------------------------------
    '导出到Excel文件中
   
    Dim r As Long                    
    Dim C As Long                    
    Dim xApp As Excel.Application '应用
    Dim xBook As Excel.Workbook    '工作薄
    Dim xSheet As Excel.Worksheet   '工作表
    Dim sCellValue As String
’下面是打开选择需要存储的目标EXCEL文件
    With CommonDialog1
       .InitDir = "C:\ "
       .FileName = " "
       .DialogTitle = "请选择Excel文件"
       .Flags = 512
       .MaxFileSize = 2048
       .CancelError = True
       .Filter = "文件(*.xls;*.xlsx)|*.xls;*.xlsx "
       .Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer
       .ShowOpen
       If Len(CommonDialog1.FileName) = 0 Then Exit Sub '如果没有选择文件那么结束
    End With
'下面是弹出保存提示，并显示保存路径和文件名
    myval = MsgBox("确定导出数据库数据到" & CommonDialog1.FileName & "中吗？", vbYesNo, "提示")
         If myval = vbYes Then
    r = rs.Fields.Count '列的数量，也就是字段数量
    C = rs.RecordCount '记录数量，也就是行数。
    Set xApp = CreateObject("Excel.Application")
    Set xBook = xApp.Workbooks.Open(CommonDialog1.FileName)’存储目标文件
    Set xSheet = xBook.Worksheets("故障停机记录")’第一张表
    '------------------------------------------------
    '查找最后一个有数据的单元格,然后+1，下移一行
    ' xSheet.usedrange.rows.count  表格的行数
    ' xSheet.Cells(w, 4) 定位单元格
    nt = 0
    For w = 1 To xSheet.UsedRange.Rows.Count'按EXCEL中总的数据行数循环
        If xSheet.Cells(w, 4) <> "" Then  '如果表中指定单元格不是空值
           nt = w + 1                     ’就将NT的值设为所循环到的那一行数值用来确定有记录的行是哪一行
        Else
           Exit For                       '循环到空值就退出循环
        End If
    Next
    '------------------------------------------------
    '开始
     '先写列头，将数据库中的字段名写到表中
    For J = 0 To r - 1                               '设置循环行数=总数r少一行
        sCellValue = rs.Fields(J).Name               '设置sCellValue值为当前一列的字段名
        xSheet.Cells(nt + 1, J + 1) = sCellValue     '写入表中相应单元格
    Next
   '-------------------------------------------------
'下面开始在EXCEL写入数据库内容
    For J = 1 To C                                        '根据查找到多少条记录C来判断循环多少次
        For I = 0 To r - 1                                '列数
            sCellValue = rs.Fields(I) & ""                '设置sCellValue值为当前一列的字段名
            xSheet.Cells(nt + J + 1, I + 1) = sCellValue  '写入表中相应单元格
        Next I
        rs.MoveNext                                       '移动到下一行数据记录
    Next J
    '------------------------------------------------
    '自动调整列
    For K = 1 To r
      xSheet.Columns(K).AutoFit
    Next
    xBook.Save                '保存***********************这里出错了，保存不了用xBook.SaveAs不是我要的结果
    xBook.Close (True)        '按内容变化关闭
    Set xBook = Nothing
    Set xApp = Nothing
    Set xSheet = Nothing
    MsgBox "导出成功!", 48, "提示"
    End If
    If cn.State = adStateOpen Then cn.Close
    If rs.State = adStateOpen Then rs.Close
    Exit Sub
end sub

[ 本帖最后由 wxflw 于 2013-6-20 07:21 编辑 ]

????????????