求助:如果在ACCESS中一个存在的EXCEL文件,增加记录.

jackieccc

我在ACCESS VBA通过这样的办法向一个存在的EXCEL文件,增加记录.

但是不能成功,为什么?

Option Compare Database
Public Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL
'* 用法：ExporToExcel(sql查询字符串)
'*********************************************************
Dim rscon As New ADODB.Connection

Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
Dim fdok As ADODB.Field

    Dim xlApp As New Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlQuery As Excel.QueryTable
   
Set rscon = CurrentProject.Connection
Rs_Data.Open "select * from " & strOpen, rscon, adOpenKeyset, adLockPessimistic
Rs_Data.MoveFirst

  
  
    With Rs_Data
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Function
        End If
        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count
    End With
   
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = Nothing
    Set xlSheet = Nothing
    Set xlBook = xlApp.Workbooks().Open("d:\book1.xls")
   
    Set xlSheet = xlBook.Worksheets("sheet1")
   
   
   
    '添加导入EXCEL数据
    i = 1
    flag = True
    Do While flag
        If xlSheet.Cells(i, j).Value = "" Then
            flag = flag
        End If
        i = i + 1
    Loop
   
    Do While Not Rs_Data.EOF
   
    j = 1
       
    For Each fdok In Rs_Data.Fields
        xlSheet.Cells(i, j).Value = Rs_Data.Fields(fdok.Name)
        j = j + 1
    Next fdok
    i = i + 1
    Rs_Data.MoveNext
    Loop
   
       
   
 
    xlApp.Application.Visible = True
    Set xlApp = Nothing  '"交还控制给Excel
    Set xlBook = Nothing
    Set xlSheet = Nothing

End Function

ikolo

不知道你用VBA用了多久了

看了你的代码，写的有写乱，可能有些内容是拼凑的。你要做的牵扯到几方面的内容，一个是简单的COM调用，AUTOMATION，这里涉及到前期绑定和后期绑定的问题，你没搞清楚。然后就是一个EXCEL的RANGE的一个方法就可以实现了。

下面这段代码你可以看看，用前期绑定。

Sub Main()

Dim Rs As New ADODB.Recordset
    Rs.Open "select * from table", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

Dim Xl As New Excel.Application
Dim WB As Excel.Workbook
Dim Sh As Excel.Worksheet

    Set WB = Xl.Workbooks.Open("C:\book1.xls")
    Set Sh = WB.Sheets(1)
    Sh.Range("a1").CopyFromRecordset Rs
   
    Xl.Visible = True

End Sub