重开一贴

[LWMWORK]

折腾了我一天了，大家给的代码也测试不过，实在愚钝，帮帮忙，给个完整方案！！！答案完整的另给100分


excel文件f1中表sheet1,第一行：姓名 年龄 部门 电话

access文件f2中表user，字段：ID、姓名、性别、年龄、部门、电话、住址 ，数据库有密码“123”

如何把f1中4个字段内容导入（追加）到f2中相应的字段中，由于“住址”为必填字段，所以暂时全部填写为“中山路125号”

[caofusheng]

把你的代码贴出来，我给你调调，写起来有点多。

[caofusheng]

首先在工程菜单点引用，选上 Microsoft Excel x.x Object Library 和 Microsoft ActiveX Data Objects x.x Library
然后在你的From中添加一个按钮，把下面的代码贴进去。一下的Excel文件（F1） 和 MDB文件（f2） 路径是工程的当前路径。

代码写的比较乱，就将就着用吧。

我测试的数据库的user表的表结构如下

ID 数字 KEY
姓名 文本
性别
年龄 数字
部门 文本
电话 文本
住址 文本

Excel文件（F1）文件内容如下

A B C D
姓名 年龄 部门 电话 本行行号 为1
AAAA 21 12 1234444
BBBB 22 13 1234445
CCCC 23 14 1234446
DDDD 24 15 1234447

Private Sub Command1_Click()

Dim lCols As Long
Dim lRows As Long
Dim excelApp As Excel.Application
Dim ExcelBook As New Workbook
Dim ExcelSheet As New Worksheet
Dim i As Long
Dim gstrConnect As String
Dim gadoCon As ADODB.Connection
Dim STRSQL As String
Dim setTemp As ADODB.Recordset
Dim lngID As Long


gstrConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "/f2.mdb;Jet OLEDB:Database Password=123;Persist Security Info=False" 'Access連接
Set gadoCon = New ADODB.Connection
With gadoCon
.ConnectionString = gstrConnect
.ConnectionTimeout = 60
.CommandTimeout = 600
.CursorLocation = adUseClient
.Open
End With

Set excelApp = CreateObject("Excel.Application") '
Set ExcelBook = excelApp.Workbooks.Open(App.Path & "\F1.xls")
Set ExcelSheet = ExcelBook.Worksheets(1)

lCols = ExcelSheet.UsedRange.Cells.Columns.Count
lRows = ExcelSheet.UsedRange.Cells.Rows.Count

STRSQL = " Select max(ID) as ID From [user]"

Set setTemp = New ADODB.Recordset
setTemp.CursorLocation = adUseServer
setTemp.CursorType = adOpenKeyset
setTemp.LockType = adLockOptimistic
setTemp.Open STRSQL, gadoCon, , , adCmdText

lngID = Val(setTemp.Fields("ID") & "")

setTemp.Close
Set setTemp = Nothing


For i = 2 To lRows
lngID = lngID + 1

STRSQL = " Select * From [user]" _
& " Where ID =" & lngID & " "

Set setTemp = New ADODB.Recordset
setTemp.CursorLocation = adUseServer
setTemp.CursorType = adOpenKeyset
setTemp.LockType = adLockOptimistic
setTemp.Open STRSQL, gadoCon, , , adCmdText

If (setTemp.BOF And setTemp.EOF) Then
setTemp.AddNew
setTemp!ID = lngID
End If


setTemp!姓名 = Trim(ExcelSheet.Range("A" & i).Value)
setTemp!年龄 = Trim(ExcelSheet.Range("B" & i).Value)
setTemp!部门 = Trim(ExcelSheet.Range("C" & i).Value)
setTemp!电话 = Trim(ExcelSheet.Range("D" & i).Value)
setTemp!住址 = "中山路125号"

setTemp.Update

setTemp.Close
Set setTemp = Nothing


Next


ExcelBook.Close
excelApp.Quit

Set excelApp = Nothing
Set ExcelBook = Nothing
Set ExcelSheet = Nothing

MsgBox "OK"

End Sub

[caofusheng]

忘了一点 数据密码是 123 在代码中可以看出来

[caofusheng]

你的excel 导入access 的帖子 我也回复了，记着给分哦 O(∩_∩)O哈哈~

[域樹臨風]

?excel 导入access 用得着写程序吗？

[LWMWORK]

to 草上飞
id不是主键，可以去掉相关代码
倒是4个字段在excel中为'空'时会有问题，
可以通过，但太繁琐，我一直在试insert into...select...,像狼行天下那样的代码，总通不过，你也帮忙试试吧！

[LWMWORK]

[Quote=引用 5 楼 zdl480 的回复:]
?excel 导入access 用得着写程序吗？
[/Quote]
在一个管理系统中，数据库是加密的，你不会想让每个用户自己打开数据库导入excel数据吗？

[caofusheng]

在工程菜单引用中找Micorsoft DAO X.X Object Library. 这就是DAO

[LWMWORK]

[Quote=引用 9 楼 caofusheng 的回复:]

狼行天下 直接 insert into 是不行的，除非你的Excel字段完全和数据库一致。
[/Quote]

不应该呀，select就是选择字段的

[LWMWORK]

[Quote=引用 8 楼 caofusheng 的回复:]

记着引用DAO
[/Quote]
ado,没用dao呀

[caofusheng]

你想要简单一点的那就给你一种简单的吧。
记着引用DAO
Private Sub Command1_Click()
Dim conn, conn2 As ADODB.Connection
Dim rs As Recordset
Dim strSQL As String

Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.Path & "/f2.mdb;Jet OLEDB:Database Password=123;Persist Security Info=False"

Set conn2 = CreateObject("ADODB.Connection")
conn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=;Extended properties=Excel 5.0;Data Source=" & App.Path & "/f1.xls"

strSQL = "SELECT * FROM [Sheet1$]"
Set rs = conn2.Execute(strSQL)

While Not rs.EOF
strSQL = ""
strSQL = strSQL & "INSERT INTO [user]([姓名],[年龄],[部门],[电话],[住址]) "
strSQL = strSQL & "VALUES ( '" & rs.Fields(0) & "','" & rs.Fields(1) & "', "
strSQL = strSQL & "'" & rs.Fields(2) & "','" & rs.Fields(3) & "','中山路125号') "
conn.Execute (strSQL)
rs.MoveNext
Wend

conn.Close
Set conn = Nothing
conn2.Close
Set conn2 = Nothing
End Sub

[caofusheng]

to 草上飞
id不是主键，可以去掉相关代码
倒是4个字段在excel中为'空'时会有问题，
可以通过，但太繁琐，我一直在试insert into...select...,像狼行天下那样的代码，总通不过，你也帮忙试试吧！

狼行天下 直接 insert into 是不行的，除非你的Excel字段完全和数据库一致。

[LWMWORK]

to 草上飞
[Quote=引用 12 楼 caofusheng 的回复:]
在工程菜单引用中找Micorsoft DAO X.X Object Library. 这就是DAO
[/Quote]
你引用了DAO，却并没有用它呀？
虽然不是最满意的答案，仍要谢谢你，
打开一个access文件，导入excel表时，只要选择了源表、目标表，就可以自动导入到相应字段，vb中怎么就不能实现呢？
两个贴，给你300分，表示感谢。