怎么用VB实现将EXCEL的数据导入到ACCESS?
要求:1.实现EXCEL数据按格式导入,即ACCESS中的格式与EXCEL的列、行一致;2.EXCEL有多列,导入ACCESS中将EXCEL第一行的数据作为主值;3.最后...
要求:1.实现EXCEL数据按格式导入,即ACCESS中的格式与EXCEL的列、行一致;
2.EXCEL有多列,导入ACCESS中将EXCEL第一行的数据作为主值;
3.最后做成APP文件,说明工程所要引用有哪些。
4.文件的路径用对话框实现,ACCESS在EXCEL路径下新建。
谢谢大家啦!
做好了可以奖300分!谢~~~~ 展开
2.EXCEL有多列,导入ACCESS中将EXCEL第一行的数据作为主值;
3.最后做成APP文件,说明工程所要引用有哪些。
4.文件的路径用对话框实现,ACCESS在EXCEL路径下新建。
谢谢大家啦!
做好了可以奖300分!谢~~~~ 展开
5个回答
展开全部
最近正好在做和你差不多的事
先在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上)接下来自己用循环做了,都是别人帮你,没意思了.
既然你这么问,数据库的东东你应该知道的了
先在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上)接下来自己用循环做了,都是别人帮你,没意思了.
既然你这么问,数据库的东东你应该知道的了
展开全部
excel的导出很简单,导入则很复杂,关系到导入文件的数据与格式,因为用户提供的excel文件是可变的,不可预知的。本人最近(包括以前一直)在研究这个问题。delphi版本已经发到网上了,发到你邮箱了,你可以参考一下,现在在想用c#开发一个更好的导入控件。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
提供一个思路吧。
工程要引用的一个对象就是ADO
把Excel和Access对视作一个ADO对象
建立两个连接,打开两个ADO的Recordset
用一个循环语句,从Excel那个Recordset读,并插入到Access那个Recordset中。
另一种解决办法是在Access中去写一段VBA放在Access模块里,Access提供一个内部方法,一条语句就把Excel的数据import到Access表中。
在外部用VB通过ADO连接Access,这样就可以调用Access的过程存贮,就是那个VBA模块,也可以实现对Excell数据的导入。
过去两种方法都实现过。没时间写具体程序,不好意思没具体帮你啊。
工程要引用的一个对象就是ADO
把Excel和Access对视作一个ADO对象
建立两个连接,打开两个ADO的Recordset
用一个循环语句,从Excel那个Recordset读,并插入到Access那个Recordset中。
另一种解决办法是在Access中去写一段VBA放在Access模块里,Access提供一个内部方法,一条语句就把Excel的数据import到Access表中。
在外部用VB通过ADO连接Access,这样就可以调用Access的过程存贮,就是那个VBA模块,也可以实现对Excell数据的导入。
过去两种方法都实现过。没时间写具体程序,不好意思没具体帮你啊。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
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
试试
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
试试
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
有现成工具为什么不用呢?
自己写有必要吗?
想用工具HI我教你?
自己写有必要吗?
想用工具HI我教你?
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |