怎么将Excel表转换成access表

[westlink]

要求用VB实现,功能和access自带的转化功能一样

[jingxiaoping]

下面我已將程序代码做成模块，只要导入必要之参数即可！
此一模块共有四个参数：
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 成为 TestTable
ExportExcelSheetToAccess "Sheet1", "C:\book1.xls", "TestTable", "C:\Test.mdb"

[dgz01]

应可进一步发挥一下,修改为通用的数据转换接口

[westlink]

to jingxiaoping:
这方法是可以将excel表转成mdb的表,但是access表的字段名却不是excel第一行所定义的,而是access在生成表是自动加的

哪位高手知道怎么解决啊

[westlink]

顶一下,没高手能解决吗

[jingxiaoping]

字段可以通过rs.fields.name进行提取。

[westlink]

还是没解决

[gump2000]

自己写吧
写个通用的
这样也很容易指定which row is field name?
用循环一条一条读取记录再添加入数据库
这样总可以了？

[sonicdater]

Excel To MDB
==================================================================
Private Sub cmdAbout_Click()
If Me.Height = 4680 Then
Me.Height = 3015
Exit Sub
End If
Me.Height = 4680
txtAbout = " Name............................Sree Kumar B.A"
txtAbout = txtAbout + vbCrLf + " Address.......................NeST Information Technologies"
txtAbout = txtAbout + vbCrLf + " Cochin,Kerala-PIN-682030"
txtAbout = txtAbout + vbCrLf + " Designation................Senior Software Engineer"
txtAbout = txtAbout + vbCrLf + " Country.......................India"
txtAbout = txtAbout + vbCrLf + " [e-mail]"
txtAbout = txtAbout + vbCrLf + " Phone No.....................91-484-426648"

End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

'----------------------------------------------------------------------------------------
' File Name: frmExcelToMdb.frm
'
' Description: This file will convert an Excel Sheet to an MDB File
' Required Softwares :VB6, Excel, Access
'
'----------------------------------------------------------------------------------------
Private Sub CmdConvert_Click()
'Calling procedure to Create the Database
Call CreateAccessDatabase
Screen.MousePointer = vbHourglass
'Calling Procedure to Create table an dInsert the Values
Call CreateAndInsertIntoTable
Screen.MousePointer = vbNormal
End Sub
'----------------------------------------------------------------------------------------
' Function Name: CreateAccessDatabase()
'
' Description: This will Create an Access Database
'----------------------------------------------------------------------------------------
Sub CreateAccessDatabase()
On Error GoTo err1

Dim catNewDB As ADOX.Catalog 'Catalog Object

Set catNewDB = New ADOX.Catalog

'Creating Database
catNewDB.Create "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source=" & App.Path & "\Test.MDB"
Set catNewDB = Nothing
Exit Sub
err1:
'If MDB Already exists then does nothing
If Err.Number = -2147217897 Then
Exit Sub
End If
End Sub
'----------------------------------------------------------------------------------------
' Function Name: CreateAndInsertIntoTable()
'
' Description: This will Create a table and will insert values to the Test Table
'----------------------------------------------------------------------------------------
Sub CreateAndInsertIntoTable()

Dim tbl As New Table
Dim cat As New ADOX.Catalog
Dim cn As New ADODB.Connection
Dim rec As New ADODB.Recordset
Dim fld As ADODB.Field
Dim recNew As New ADODB.Recordset
Dim strExcelPath As String
Dim intcnt As Long

'Excel File Path
strExcelPath = App.Path & "\Book1.xls"

'Opening Catalog Connection
cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.3.51;" & _
"Data Source=" & App.Path & "\Test.MDB"

'Opening Excel Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source= " & strExcelPath & ";Extended Properties=Excel 8.0;" _
& "Persist Security Info=False"

'Opening Sheet in Excel Sheet Like a Table
rec.Open "Select * from [Sheet1$]", cn, adOpenKeyset

'To delete If "Test" Table is already there
If cat.Tables.Count <> 4 Then cat.Tables.Delete "Test"
'------------------------------------------------------------------------------------
'Creating Table
'------------------------------------------------------------------------------------
'Assigning Table Name
tbl.Name = "Test"
'Appending Column-The Col Name will be the Column name from the Sheet
For Each fld In rec.Fields
tbl.Columns.Append fld.Name, adChar, 200
Next
'Creating Table using Catalog Object of ADOX
cat.Tables.Append tbl
'Opening the Newly created table in Test.MDB
recNew.Open "Test", cat.ActiveConnection, adOpenKeyset, adLockOptimistic
'Making Pg Bar Visible
ProgressBar1.Visible = True
'Setting Max value of Pg BAr as No of Records in the Sheet
If rec.RecordCount <> 0 Then
ProgressBar1.Max = rec.RecordCount
End If
'Initialising Counter
intcnt = 1
Do Until rec.EOF
'Calling DoEvents so as to see the counter correctly
DoEvents
With recNew
.AddNew
For Each fld In rec.Fields
'Assigning value to the recNew Recordset for Insertion
.Fields(fld.Name) = IIf(IsNull(rec(fld.Name)), "", rec(fld.Name))
Next
.Update
End With
'Assigning Value to PgBar Control
ProgressBar1.Value = intcnt
'Assigning Value to Label Control
lblStatus.Caption = "Added " & intcnt & " Records..."
'Incrementing Counter
intcnt = intcnt + 1
'Moving to Next Record
rec.MoveNext
Loop
DoEvents
'Showing the Location of MDB File
lblStatus.Caption = "Open the MDB File at " & App.Path & "\Test.Mdb"
ProgressBar1.Visible = False
End Sub
Private Sub Form_Load()
Me.Height = 3015
End Sub