vb读取excel数据的教程

在Excle中录入好数据以后，可能会需要用VB进行读取Excle数据，具体该如何读取数据呢?下面是我带来的关于vb读取excel数据的教程，希望阅读过后对你有所启发!

vb读取excel数据的教程：

Private Sub Form_Load()

Text1.Text = App.Path &"\123.xls"

Text2.Text = App.Path &"\123.mdb"

Text3.Text = "sheet1"

Text4.Text = "sheet1"

Data1.DatabaseName = App.Path &"\123.mdb"

End Sub

Private Sub Command1_Click()

Dim db As Database

Dim sheet As String, excelpath As String, AccessPath As String, AccessTable As String

AccessPath = Text2.Text '数据库路径

excelpath = Text1.Text '电子表格路经

AccessTable = Text4.Text '数据库内表格

sheet = Text3.Text '电子表格内工作表

Set db = OpenDatabase(excelpath, True, False, " Excel 5.0") '打开电子表格文件

SQL = ("Select * into [database=" &AccessPath &"]." &AccessTable &" FROM [" &sheet &"$]")

db.Execute (SQL) '将电子表格导入数据库

Data1.RecordSource = "sheet1"

Data1.Refresh

DBGrid1.Refresh '显示电子表格导入到数据库的数据

End Sub

上面的是把EXCEL读取到数据库中,你做点修改就行了.一个Data控件.

Private Sub Command1_Click()

Dim fileadd As String

CommonDialog1.ShowOpen

CommonDialog1.Filter = "xls文件(*.xls)|*.xls" '选择你要的文件

fileadd = CommonDialog1.FileName

If fileadd = "" Then Exit Sub

Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象

Set xlBook = xlApp.Workbooks.Open(fileadd) '打开已经存在的EXCEL工件簿文件

xlApp.Visible = False ' = True '设置EXCEL对象可见（或不可见）

Set xlSheet = xlBook.Worksheets(1) '设置活动工作表

For R = 1 To 99999 '行循环

If LTrim(RTrim(xlBook.Worksheets(1).Cells(R, 1))) <>"" Then

Call Dosql("INSERT INTO CB_JiXieFeiYong (danwei_name) VALUES (" &LTrim(RTrim(xlBook.Worksheets(1).Cells(R, 1))) &")")

Else

R = 99999 + 1

End If

Next R

xlApp.DisplayAlerts = False '不进行安全提示 '

Set xlSheet = Nothing '

Set xlBook = Nothing '

xlApp.Quit '

Set xlApp = Nothing

Unload Me

End Sub

Private Sub Dosql(ByVal tn As String) '执行SQL语句

Dim sql As String

Set conn = New ADODB.Connection

conn.ConnectionString = condstr

conn.Open

conn.Execute tn

conn.Close

End Sub

这段代码估计对你有用。

'ToDo: 设置 common dialog 控件的标志和属性.Filter = "Excel文件 (*.xls) |*.xls".ShowOpenIf Len(.FileName) = 0 ThenExit SubEnd Ifsfile = .FileNameEnd WithAccessPath = lcspath &"\db.mdb" '数据库路径excelpath = sfile '电子表格路经AccessTable = "db" '数据库内表格msg = Trim(InputBox("请输入表名，如sheet1或sheet2：", "工作表", "sheet1"))' msg = Str(msg)sheet = msg '电子表格内工作表Set db = OpenDatabase(excelpath, True, False, "Excel 8.0") '打开电子表格文件sql = ("Select * into [database=" &AccessPath &"]." &AccessTable &" FROM [" &sheet &"$]")' sql = ("Select * into [database=" &AccessPath &"]." &AccessTable &" FROM [" &sheet &"]")If sheet = "" ThenMsgBox "您选择的EXCEL表不存在，请重新导入！", vbInformation, "抱歉！"Exit SubEnd IfIf deltable = 1 ThenWith ADOsdb.Execute "drop table db", , adCmdTextEnd WithEnd IfADOsdb.CommitTransdb.Execute (sql) '将电子表格导入数据库ShowMessage "正在导入EXCEL表，请您稍等..."

---