excel数据导入access和SQL2000的小问题

wzw117

现在我手上有一个excel做的制造费用分配表，
如下面的示例表：
项目名称        分配车间        辅助材料   人工费        制造费用
907418        锻造车间        100849.57 44119.05 40251.11
712606        锻造车间        279.88        122.44        111.71
801307        锻造车间        607.26        265.66        242.37
803619        锻造车间        167        73.06        66.65
810302        金结车间        54.95        6525.26        4121.24
810303        金结车间        13.43        1595.06        1007.41
811105        金结车间        30.53        3625.15        2289.58
811209        金结车间        2.44        290.01        183.17
811414        机加车间        113.22        264.08        172.09
902404        机加车间        311.37        726.23        473.24
902410        机加车间        311.37        726.23        473.24
903101        机加车间        141.53        330.11        215.11

需要把里面的数据一个个的录入到数据库中（使用财务软件），很麻烦很麻烦（功能限制，不能批量操作），而且容易出错。

我花了一个晚上做了一个Access的示例，请大家看看 excel数据导入access.rar (52.82 KB, 下载次数: 43)

2009-9-3 10:10 上传

点击文件名下载附件
excel数据导入access

，这样容易理解我的意图，更好的帮到我。
请教各位大侠的问题是：
1、怎样将此表（Excel表中的'分配表'）的数据批量导入到ACCESS中的3个表（辅助核算，凭证，凭证明细）中，并且是添加到数据库原有数据的后面。
2、怎样从ACCESS或SQL 2000中导出数据到excel？（excel中的导入外部数据可以实现，但我想要VBA的，呵呵）
3、Access中数据如何添加到SQL 2000数据库原有数据的后面？（2个数据库中的表和字段是一一对应的）

[ 本帖最后由 wzw117 于 2009-9-3 10:11 编辑 ]

wzw117

感谢。版主万岁！

wzw117

我在这里逛来逛去，没有人答话啊。

wzw117

没有一个人回帖哦。

Scarlett_88

我提供几个例子给你：
Public Sub 实例7_11()’当前工作表数据保存到SQL Server
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Long
    Dim mydata As String, myTable As String, SQL As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = ThisWorkbook
    Set ws = wb.Sheets("sheet1")
    mydata = "工资管理"
    myTable = "基本信息"
    Set cnn = New ADODB.Connection
    With cnn
        .ConnectionString = "Provider=SQLOLEDB.1;" _
            & "User ID=sa;" _
            & "Data Source=THTFCOMPUTER;" _
            & "Initial Catalog=" & mydata
        .Open
    End With
    n = ws.Range("A65536").End(xlUp).Row
    For i = 2 To n
        SQL = "select * from " & myTable _
        & " where 职工编号='" & Trim(ws.Cells(i, 1).Value) & "'" _
        & " and 姓名='" & Trim(ws.Cells(i, 2).Value) & "'" _
        & " and 性别='" & Trim(ws.Cells(i, 3).Value) & "'" _
        & " and 所属部门='" & Trim(ws.Cells(i, 4).Value) & "'" _
        & " and 工资总额=" & Trim(ws.Cells(i, 5).Value) _
        & " and 备注='" & Trim(ws.Cells(i, 6).Value) & "'"
        Set rs = New ADODB.Recordset
        rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
        If rs.EOF And rs.BOF Then
            rs.AddNew
            For j = 1 To rs.Fields.Count
                rs.Fields(j - 1) = Trim(ws.Cells(i, j).Value)
            Next j
            rs.Update
        Else
            For j = 1 To rs.Fields.Count
                rs.Fields(j - 1) = Trim(ws.Cells(i, j).Value)
            Next j
            rs.Update
        End If
    Next i
    MsgBox "数据保存完毕！", vbInformation, "保存数据"
    rs.Close
    cnn.Close
    Set wb = Nothing
    Set ws = Nothing
    Set rs = Nothing
    Set cnn = Nothing
End Sub
将SQL Server数据库数据保存为Access数据库
Public Sub 实例7_13()
    Dim cnnSQL As New ADODB.Connection
    Dim rsSQL As New ADODB.Recordset
    Dim cnnData As New ADODB.Connection
    Dim rsData As New ADODB.Recordset
    Dim myCat As New ADOX.Catalog
    Dim myTbl As New ADOX.Table
    Dim mySQL As String
    Dim myData As String
    Dim myTable As String
    Dim myName As String, myType As Integer, mySize As Integer
    Dim i As Long, j As Long
    myData = "商品信息"
    myTable = "商品名录"
    CnnStr = "Provider=SQLOLEDB.1;" _
        & "User ID=sa;" _
        & "Data Source=THTFCOMPUTER;" _
        & "Initial Catalog=" & myData
    With cnnSQL
        .ConnectionString = CnnStr
        .Open
    End With
    rsSQL.Open myTable, cnnSQL, adOpenKeyset, adLockOptimistic
    myData = ThisWorkbook.Path & "\商品信息.mdb"
    On Error Resume Next
    Kill myData
    On Error GoTo 0
    myCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & myData
    With myTbl
        .Name = myTable
        For i = 0 To rsSQL.Fields.Count - 1
            myName = rsSQL.Fields(i).Name
            myType = rsSQL.Fields(i).Type
            If rsSQL.Fields(i).Type = 200 Then myType = adVarWChar
            If rsSQL.Fields(i).Type = 135 Then myType = adDate
            mySize = rsSQL.Fields(i).DefinedSize
            .Columns.Append myName, myType, mySize
        Next i
    End With
    myCat.Tables.Append myTbl
    Set cnnData = myCat.ActiveConnection
    rsData.Open myTable, cnnData, adOpenKeyset, adLockOptimistic
    For i = 1 To rsSQL.RecordCount
        With rsData
            .AddNew
            For j = 0 To rsData.Fields.Count - 1
                .Fields(j) = rsSQL.Fields(j).Value
            Next j
            .Update
        End With
        rsSQL.MoveNext
    Next i
    MsgBox "已经成功将SQL Server数据库数据保存为Access数据库！" & vbCrLf _
        & "数据库名为：<" & Mid(myData, Len(ThisWorkbook.Path) + 2) & ">" _
        & vbCrLf & "数据表名为：<" & myTable & ">", vbInformation
    rsSQL.Close
    cnnSQL.Close
    rsData.Close
    cnnData.Close
    Set rsSQL = Nothing
    Set cnnSQL = Nothing
    Set rsData = Nothing
    Set cnnData = Nothing
End Sub
将SQL server的数据库导入到excel文件中
Public Sub 实例7_9()
    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim i As Long
    Dim mydata As String, myTable As String, SQL As String
    mydata = "工资管理"
    myTable = "基本信息"
    Set cnn = New ADODB.Connection
    With cnn
        .ConnectionString = "Provider=SQLOLEDB.1;" _
            & "User ID=sa;" _
            & "Data Source=THTFCOMPUTER;" _
            & "Initial Catalog=" & mydata
        .Open
    End With
    SQL = "select * from " & myTable & " where 性别='男'"
    Set rs = New ADODB.Recordset
    rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    Cells.Clear
    With rs
        For i = 1 To .Fields.Count
            Cells(1, i).Value = .Fields(i - 1).Name
        Next
        Range("A2").CopyFromRecordset rs
    End With
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub
Access 数据库输出到Excel中
Public Sub 实例2_22()
    Dim cnn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim myData As String
    Dim ws As Worksheet
    Dim i As Long
    myData = ThisWorkbook.Path & "\客户管理.mdb"
    '建立与数据库的连接
    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open myData
    End With
   '打开数据记录集（根据参数的不同，所获取的数据库模式信息也不同）
   Set rs = cnn.OpenSchema(adSchemaColumns)       '列信息
   'Set rs = cnn.OpenSchema(adSchemaProcedures)      '过程信息
   'Set rs = cnn.OpenSchema(adSchemaViews)      '视图信息
   'Set rs = cnn.OpenSchema(adSchemaPrimaryKeys)      '主键信息
   'Set rs = cnn.OpenSchema(adSchemaIndexes)       '索引信息
    '创建新工作表
    Set ws = Worksheets.Add
    '将获取的信息输入到新建的工作表中
    With rs
       '获取列名
        For i = 1 To .Fields.Count
            ws.Cells(1, i).Value = .Fields(i - 1).Name
        Next
       '复制记录集数据
        ws.Range("A2").CopyFromRecordset rs
    End With
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

Scarlett_88

我这段时间忙，自己对应表改改做做吧