怎么用VB实现将EXCEL的数据导入到ACCESS？

Question

要求：1.实现EXCEL数据按格式导入，即ACCESS中的格式与EXCEL的列、行一致；
2.EXCEL有多列，导入ACCESS中将EXCEL第一行的数据作为主值；
3.最后做成APP文件，说明工程所要引用有哪些。
4.文件的路径用对话框实现，ACCESS在EXCEL路径下新建。
谢谢大家啦！
做好了可以奖300分！谢~~~~

Answer 1

最近正好在做和你差不多的事
先在Module1中打入
Option Explicit
Public xlapp As Object 'Excel对象
Public xlbook As Object '工作簿
Public xlsheet As Object '工作表
Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

然后新窗体中打入

Dim f As Integer
Sub GetExcel()
Dim MyXL As Object '用于存放Microsoft Excel 引用的变量。
Dim ExcelWasNotRunning As Boolean '用于最后释放的标记。

On Error Resume Next '延迟错误捕获。

'不带第一个参数调用Getobject函数将返回对该应用程序的实例的引用。
'如果该应用程序不在运行，则会产生错误。
Set MyXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then ExcelWasNotRunning = True
Err.Clear '如果发生错误则要清除 Err 对象。

'检测 Microsoft Excel。如果 Microsoft Excel 在运行，则将其加入运行对象表。
DetectExcel '该过程检测并登记正在运行的 Excel

'设置其 Application 属性，显示 Microsoft Excel。
'然后使用 MyXL 对象引用的 Windows 集合,显示包含该文件的实际窗口。
MyXL.Application.Visible = True
MyXL.Parent.Windows(1).Visible = True

'如果在启动时，Microsoft Excel 的这份副本不在运行中，
'则使用 Application 属性的 Quit 方法来关闭它。
'注意，当试图退出 Microsoft Excel 时，
'标题栏会闪烁，并显示一条消息询问是否保存所加载的文件。
If ExcelWasNotRunning = True Then
MyXL.Application.Quit
End If
Set MyXL = Nothing '释放对该应用程序和电子数据表的引用。
End Sub

'该过程检测并登记正在运行的 Excel。
Sub DetectExcel()
Const WM_USER = 1024
Dim hwnd As Long

'如果 Excel 在运行，则该 API 调用将返回其句柄。
hwnd = FindWindow("XLMAIN", 0)
If hwnd = 0 Then '0 表示没有 Excel 在运行。
Exit Sub
Else
'Excel 在运行，因此可以使用 SendMessage API'函数将其放入运行对象表。
SendMessage hwnd, WM_USER + 18, 0, 0
End If
End Sub

Private Sub cmdRun_Click()
Dim intLow, intCol As Integer

Call GetExcel
Set xlapp = GetObject(App.Path + "\轮滑社08招新成员.xls") '打开模扳文件
xlapp.Parent.Windows(1).Visible = True '使父窗体可见
Set xlsheet = xlapp.Application.Worksheets(1) '当前工作簿的第一页

Dim s1
s1 = xlsheet.Cells(f, j) '当前工作簿第一页的第I行第J列

End Sub

最后s1那就是从EXCEL的列、行取东东的.你可dim,s1,s2,s3......
数据提取了,你可以用ADO导入.(s1,s2,s3放在已与ADO联接的TEXT上)接下来自己用循环做了,都是别人帮你,没意思了.

既然你这么问,数据库的东东你应该知道的了

Answer 2

excel的导出很简单，导入则很复杂，关系到导入文件的数据与格式，因为用户提供的excel文件是可变的，不可预知的。本人最近（包括以前一直）在研究这个问题。delphi版本已经发到网上了，发到你邮箱了，你可以参考一下，现在在想用c#开发一个更好的导入控件。

Answer 3

提供一个思路吧。
工程要引用的一个对象就是ADO
把Excel和Access对视作一个ADO对象
建立两个连接，打开两个ADO的Recordset
用一个循环语句，从Excel那个Recordset读，并插入到Access那个Recordset中。

另一种解决办法是在Access中去写一段VBA放在Access模块里，Access提供一个内部方法，一条语句就把Excel的数据import到Access表中。
在外部用VB通过ADO连接Access，这样就可以调用Access的过程存贮，就是那个VBA模块，也可以实现对Excell数据的导入。

过去两种方法都实现过。没时间写具体程序，不好意思没具体帮你啊。

Answer 4

Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cnstring As String
Dim sql As String
Dim meterno As Integer

Private Sub ComboBox1_Change()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
database = "Electricity.mdb"
sql = "select encl,meterno from Account where AccountNumber=" & "'" & UserForm1.ComboBox1.Value & "'"
' MsgBox sql
cnstring = ThisWorkbook.Path & "\" & database
CommandButton1.Visible = False
CommandButton2.Visible = False
CommandButton3.Visible = False
CommandButton4.Visible = False
Label3.Visible = False
Label4.Visible = False
Framemeter1.Caption = ""
Framemeter2.Caption = ""
Framemeter3.Caption = ""
TreeView1.Nodes.Clear
For i = 8 To 15
UserForm1.Controls("textbox" & i).Visible = True
Next i

For i = 18 To 25
UserForm1.Controls("textbox" & i).Visible = True
Next i

For i = 28 To 35
UserForm1.Controls("textbox" & i).Visible = True
Next i

With cn
.Provider = "microsoft.jet.oledb.4.0"
.Open cnstring
End With
rs.Open sql, cn, adOpenKeyset, adLockOptimistic

' MsgBox rs.Fields("encl")

TextBox7.Value = rs.Fields("encl")
meterno = rs.Fields("meterno")
' MsgBox meterno
rs.Close

TextBox6.SetFocus

sql = "select meternumber from meter where encl=" & "'" & TextBox7.Value & "'"
rs.Open sql, cn, adOpenKeyset, adLockOptimistic
rs.MoveFirst

For i = 1 To rs.RecordCount
UserForm1.Controls("commandbutton" & i).Caption = rs.Fields("meternumber")
UserForm1.Controls("framemeter" & i).Caption = rs.Fields("meternumber")
rs.MoveNext
Next i

MultiPage1.Value = 0
rs.Close

For i = 1 To meterno
UserForm1.Controls("commandbutton" & i).Visible = True
'MsgBox ButtonName
' ButtonName.Visible = True
Next i

sql = "select BillAmount,BillDate from BillAmount where AccountNumber=" & "'" & UserForm1.ComboBox1.Value & "' order by BillDate desc"
rs.Open sql, cn, adOpenKeyset, adLockOptimistic

TreeView1.LineStyle = tvwRootLines
TreeView1.Style = tvwTreelinesPlusMinusText
TreeView1.LabelEdit = tvwManual
n = rs.RecordCount

Dim a As Date
Dim b As String

rs.MoveFirst
For i = 1 To n
a = rs.Fields("BillDate")
b = rs.Fields("BillAmount")
c = Str(a) & ".....$" & Format(b, "###,###.##")
Set nodx = TreeView1.Nodes.Add(, , c, c)
rs.MoveNext
Next i

If UserForm1.Controls("framemeter3").Caption = "" Then
For i = 28 To 37
UserForm1.Controls("textbox" & i).Visible = False
Next i
End If

If UserForm1.Controls("framemeter2").Caption = "" Then
For i = 8 To 17
UserForm1.Controls("textbox" & i).Visible = False
Next i
End If

试试

Answer 5

有现成工具为什么不用呢？
自己写有必要吗？
想用工具HI我教你？