'在工程中添加对Excel的引用
DimxlsAppAsExcel.Application
DimxlsBookAsExcel.Workbook
PrivateSubCommand1_Click()
DimIAsInteger
SetxlsApp=Excel.Application
xlsApp.Visible=False
SetxlsBook=xlsApp.Workbooks.Open("D:\11.xls")
I=1
DoWhilexlsApp.Sheets(1).cells(I,1)<>""
I=I+1
Loop
xlsApp.Sheets(1).cells(I,1)=Text1.Text
xlsBook.Close(True)
xlsApp.Quit
SetxlsApp=Nothing
MsgBox"数据写入成功!"
EndSub
方法一:可以试着用VB书写一段调用SQLServer数据库DTS的代码,然后就可以像直接使用DTS进行数据导入一样就行Excel与SQLServer数据之间的迁移了。
方法二:可以用VB来 *** 作EXCEL,然后一条数据一条数据的插入到数据库中,这种方法不推荐使用,因为VB *** 作EXCEL是非常慢的,如果数据量太大,很有可能会造成机。
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
这段代码估计对你有用。
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)