ADO DataGrid 与Excel数据连接

Question

Dim sSql As String, conn As New ADODB.Connection, rs As New ADODB.Recordset
conn.CursorLocation = adUseClient
conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.Path & "/abc.xls"
Sql = "select * from [sheet1$]"
rs.CursorLocation = adUseClient
rs.Open Sql, conn
DGrid1.ClearFields
Set DGrid1.DataSource = rs
DGrid1.Refresh

Answer 1

数据可以连接，也可显示，就是到第二次跟新数据时出现上图，说无法访问文件！往Excel里写好数据后也关闭了应用程序的！代码如下，请大大帮我看下
Public Sub main()
    Dim i As Long
    ReportName = Year(Date) & "-Report.xls"         'Excel报表文件命名
    DbName = Year(Date) & "-DataBasic.xls"         'Excel数据文件命名
    fn = App.Path & "\" & ReportName
    Dim xlapp As Excel.Application
    Dim xlbook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    '创建报表
    If Dir(App.Path & "\" & ReportName) = "" Then         '查询文件是否存在
        Set xlapp = New Excel.Application             '声明对象变量
        xlapp.Visible = True                          '可见
        xlapp.SheetsInNewWorkbook = 1                 '工作薄数量为1个
        Set xlbook = xlapp.Workbooks.Add              '增加工作薄
        xlbook.Sheets("sheet1").Name = "Report"       'Sheet1改名Report
        xlbook.Sheets.Add after:=xlbook.Sheets(1)     '增加工作表在第一个Sheet之后
        xlbook.Sheets("sheet2").Name = "Result"       'Sheet2改名
        Set xlSheet = xlbook.Worksheets("Report")     '声明Report工作表
        With xlSheet
            .Cells(1, 1) = "CW-周期"
            .Cells(1, 2) = "Date-日期"
            .Cells(1, 3) = "Project NO.-产品订单号"
            .Cells(1, 4) = "Planed Output-计划输出"
            .Cells(1, 5) = "Actual Output-实际输出"
            .Cells(1, 6) = "Efficiency-效率"
            .Cells(1, 7) = "Times of Error Breakdown-报警时间"
            .Cells(1, 8) = "Hours of Error Breakdown-报警(小时)"
        End With
        xlSheet.Cells.EntireColumn.AutoFit                          '自动调整列宽
        xlbook.SaveAs App.Path & "\" & ReportName
        xlbook.Close (True)
        Set xlbook = Nothing
        Set xlSheet = Nothing
        xlapp.Quit
        Set xlapp = Nothing
    End If
    '创建数据表
    If Dir(App.Path & "\" & DbName) = "" Then
        Set xlapp = New Excel.Application
        xlapp.Visible = True
        xlapp.SheetsInNewWorkbook = 1
        Set xlbook = xlapp.Workbooks.Add
        xlbook.SaveAs App.Path & "\" & DbName
        xlbook.Close (True)
        xlapp.Quit
        Set xlapp = Nothing
    End If
    Test.Show
End SubPrivate Sub Form_Load()
     Dim cn As New ADODB.Connection
        Dim rs As New ADODB.Recordset
        Str = "Provider = Microsoft.Jet.OLEDB.4.0;"
        Str = Str & "Persist Security Info=False;"
        Str = Str & "Data Source=" & fn & ";Extended Properties='Excel 8.0;HDR=yes;IMEX=2'"
'        cn.CursorLocation = adUseClient   '游标类型
'        cn.Open Str
        Adodc1.ConnectionString = Str
'        rs.Open "select * from [Report$]", cn, adOpenKeyset, adLockPessimistic  '打开记录集
        Adodc1.RecordSource = "select * from [report$]"    Stopflat = True
End SubPrivate Sub Start_Click()        '开始连接
    Dim Receive As String
    Dim StatusReceive As String
    Dim PlanReceive As String
    Dim ReportReceive As String
    Dim j As Integer
    Dim i As Integer
    On Error GoTo err
    Stopflat = False
    Sendflat = True
    i = 1 Dim xlapp As Excel.Application
        Dim xlbook As Excel.Workbook
        Dim xlSheet As Excel.Worksheet
        Set xlapp = New Excel.Application
        xlapp.Visible = False
        xlapp.DisplayAlerts = False
        Set xlbook = xlapp.Workbooks.Open(App.Path & "\" & ReportName)
        Set xlSheet = xlapp.Worksheets("report")
'        j = ActiveSheet.UsedRange.Rows.Count
        j = j + 1
        With xlSheet                                             '工作表赋值
            .Cells(j, 1) = j & "-CW-周期"
            .Cells(j, 2) = j & "Date-日期"
            .Cells(j, 3) = j & "Project NO.-产品订单号"
            .Cells(j, 4) = j & "Planed Output-计划输出"
            .Cells(j, 5) = j & "Actual Output-实际输出"
            .Cells(j, 6) = j & "Efficiency-效率"
            .Cells(j, 7) = j & "Times of Error Breakdown-报警时间"
            .Cells(j, 8) = j & "Hours of Error Breakdown-报警(小时)"
        End With
        xlbook.SaveAs App.Path & "\" & ReportName
        xlbook.Close (True)
        xlapp.Quit
        Set xlbook = Nothing
        Set xlapp = Nothing
         DataGrid1.ClearFields
         Set DataGrid1.DataSource = Adodc1                 '连接到DataGrid
         DataGrid1.Refresh
'        DataGrid1.Refresh
       
'    End If
    
    Loop While (Stopflat = False)
    If Stopflat = False Then
        Readyflat = False
    End If
err:
    MsgBox err.Description
End Sub