把excel中的数据导入SQL SERVER数据库(access数据类似):
Private Sub Command1_Click()
Dim strconn As String ' 定义Excel 连接字符串
Dim cn As ADODB.Connection ' 定义Excel 连接
Set cn = New ADODB.Connection
' 初始化commandialog1 的属性,选取Excel 文件,文
' 件名保存在CommanDialog1.filename 中备用
CommonDialog1.Filter = " 电子表格文件(.xls) |*.xls"
CommonDialog1.DialogTitle = " 请选择要导入的文件"
CommonDialog1.ShowOpen
' 设置连接SQL 数据库的连接字符串
strtemp = " [odbc;Driver= {SQL Server} ;Server=(local);Database=Afws;UID=sa;PWD=sa]"
' 设置Excel 数据连接
strconn = " Provider =Microsoft.Jet.OLEDB.4.0;Data Source=" & CommonDialog1.FileName & " ; Extended Properties=Excel 8.0"
cn.Open strconn
strSql = "insert into " & strtemp & ".hw_level1 select * from [sheet1$]"
cn.Execute strSql, lngRecsAff, adExecuteNoRecords
MsgBox " 成功导入到SQL 数据库中!", vbExclamation + vbOKOnly
cn.Close
Set cn = Nothing
End Sub
从access数据库中导出数据到为excel(sql数据库类似):
dimconnasadodb.connectionDimrs1AsNewADODB.Recordsetdimsqlasstringsetconn=newadodb.connectionifconn.state<>0thenconn.close
conn.open"Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source="&App.Path&"\sclsylb.mdb"sql="SELECT * FROM QS800"'QS800表你应该很熟悉ifrs1.state<>0thenrs1.close
rs1.cursorlocation=aduserclient
rs1.open sql,conn,1,3'导出xls表DimxlAppAsNewExcel.ApplicationDimxlBookAsExcel.WorkbookDimxlSheetAsExcel.WorksheetDimxlQueryAsExcel.QueryTable'On Error GoTo OutPutErrSetxlBook=xlApp.Workbooks().AddSetxlSheet=xlBook.Worksheets("sheet1")SetxlQuery=xlSheet.QueryTables.Add(rs1, xlSheet.Range("a1"))WithxlQuery
.FieldNames=True.RowNumbers=False.FillAdjacentFormulas=False.PreserveFormatting=True.RefreshOnFileOpen=False.BackgroundQuery=True.RefreshStyle=xlInsertDeleteCells
.SavePassword=True.SaveData=True.AdjustColumnWidth=True.RefreshPeriod=0.PreserveColumnInfo=TrueEndWithxlQuery.FieldNames=TruexlQuery.Refresh
cmdlg.Flags=2cmdlg.Filter="EXCEL文档(*.xls)"cmdlg.ShowSaveIfcmdlg.FileName<>""ThenxlApp.DisplayAlerts=FalsexlBook.SaveAs FileName:=cmdlg.FileNameIfMsgBox("导出成功,是否打开查看?", vbOKCancel,"导出EXCEL")=vbOKThenxlApp.Workbooks().Open cmdlg.FileName
xlApp.Visible=TrueElsexlApp.QuitEndIfEndIfIfxlApp<>NullThenSetxlApp=Nothingsetconn=nothingsetrs1=nothing