怎样利用VB将EXCEL中的数据导入ACCESS

Question

怎样利用VB将EXCEL中的数据导入ACCESS

Answer 1

    如何將 Excel 的文件导入 Access文件？ 
 
　
引用DAO
下面我已將程序代码做成模块，只要导入必要之参数即可！此一模块共有四个参数：
1、sSheetName：要导出资料的文件名称 (Sheet name)，例如 Sheet1
2、sExcelPath：要导出资料的 Excel 档案路径名称 (Workbook path)，例如 C:\book1.xls
3、sAccessTable：要导入的 Access Table 名称，例如 TestTable
4、sAccessDBPath：要导入的 Access 档案路径名称，例如 C:\Test.mdb在声明中加入以下：Private Sub ExportExcelSheetToAccess(sSheetName As String, _
sExcelPath As String, sAccessTable As String, sAccessDBPath As String)
Dim db As Database
Dim rs As Recordset
Set db = OpenDatabase(sExcelPath, True, False, "Excel 5.0")
Call db.Execute("Select * into [;database=" & sAccessDBPath & "]." & _
sAccessTable & " FROM [" & sSheetName & "$]")
MsgBox "Table exported successfully.", vbInformation, "Yams"
End Sub
使用范例如下：將 C:\book1.xls 中的 Sheet1 导入 C:\Test.mdb 成为 TestTableExportExcelSheetToAccess "Sheet1", "C:\book1.xls", "TestTable", "C:\Test.mdb" 
   
　
  
 

Answer 2

以下是我写的一个导入按钮的源码，你可根据自己的实际情况改动：Private Sub cmdInPut_Click()                      '导入按钮
    Dim tempxlApp As New Excel.Application
    Dim tempxlWorkbook As New Excel.Workbook
    Dim tempxlSheet As New Excel.Worksheet
    
    Dim strXlsName As String           'Excel 文件名
    Dim strSheet As String             '表名
    Dim strPcode As String             '产品编号
    Dim strTmp As String
    Dim rsViewP As ADODB.Recordset
    Dim n As Integer                   '行数
    Dim i As Integer
    Dim iNum As Single                 '数量
    Dim iCai As Single                 '材数
    
  On Error Resume Next
    
    cdlInPut.CancelError = True                   'cdlInPut为CommonDialog控件
    
    '属性DialogTitle是要弹出的对话框的标题
    cdlInPut.DialogTitle = "选择 Microsoft Excel 文件"
    
    '缺省的文件名为空
    cdlInPut.FileName = ""
    cdlInPut.Filter = "Excel 文件 (*.xls)|*.xls"
    
    'Flags属性的用法依据不同的对话框而变
    cdlInPut.Flags = cdlOFNHideReadOnly + cdlOFNFileMustExist
    cdlInPut.ShowOpen
    If Err = cdlCancel Then Exit Sub
    strPicName = cdlInPut.FileName
    
    strSheet = Trim(InputBox("请指定所打开的Excel文件中的一个工作表：", "指定工作表"))
    If strSheet = "" Then
        MsgBox ("你必须指定一个工作表！"), vbOKOnly + vbExclamation, "提醒！"
        Exit Sub
    End If
    n = InputBox("输入需导入行数：", "行数", 114)
        
    prgInput.Visible = True                           'prgInput为进程条控件
    prgInput.Max = n
    
    '打开Excel 文件
    Set tempxlWorkbook = tempxlApp.Workbooks.Open(strPicName)
    tempxlApp.DisplayAlerts = False
    Set tempxlSheet = tempxlWorkbook.Worksheets(strSheet)
    tempxlSheet.Select
    
    prgInput.Value = 1
    '把Excel表格中的数据导入表EachDay
    For i = 4 To n
        strPcode = tempxlSheet.Cells(i, 5)
        iNum = tempxlSheet.Cells(i, 17)
        If strPcode <> "" And iNum <> 0 Then
            strTmp = "select * from Inventory where cInvCode ='" & strPcode & "'"
            Set rsViewP = New ADODB.Recordset
            rsViewP.Open strTmp, cnHhsoft, adOpenKeyset, adLockOptimistic
            iCai = rsViewP!iCai
            If rsViewP.RecordCount > 0 Then
                '把记录添加到EachDay表中
                strTmp = "Insert into EachDay (cInvCode,iCount,iRent,dOutDay,cDCCode) VALUES('" & strPcode & "'," & iNum & "," & iNum * iCai & ",#" & rqCH.Value & "#,'" & dcbNetNode.BoundText & "')"
                cmSe.CommandText = strTmp
                cmSe.Execute
            Else
                MsgBox ("此产品不存在！编号：" & strPcode), vbOKOnly + vbExclamation, "提醒！"
            End If
            rsViewP.Close
            Set rsViewP = Nothing
        End If
        prgInput.Value = i - 2
    Next i
    
    '释放对象,关闭excel
    Set tempxlSheet = Nothing
    Set tempxlWorkbook = Nothing
    tempxlApp.Quit
    Set tempxlApp = Nothing
    
    prgInput.Value = n
    prgInput.Visible = False
End Sub