7,762
社区成员
发帖
与我相关
我的任务
分享
With CommonDialog1
.FileName = "*.xls"
.DialogTitle = "Select Excel file to open"
.Filter = "Excel files|(*.xls)"
.FilterIndex = 0
.InitDir = App.Path
.Flags = cdlOFNHideReadOnly
.ShowOpen
If .FileName = "*.xls" Then Exit Sub
End With
'先打开EXCEL,得到EXCEL内容
Dim con As New OleDb.OleDbConnection("provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & Maintext.Text)
’Maintext.Text 为EXCEL的路径
con.Open()
Dim cmd As New OleDb.OleDbCommand("select * from [sheet1]", con)
Dim adapter As OleDb.OleDbDataAdapter = New OleDb.OleDbDataAdapter(cmd)
Dim DS As New DataSet
Try
adapter.Fill(DS, "DS")
Catch EX As Exception
MsgBox(EX.ToString, MsgBoxStyle.Critical)
Exit Sub
End Try
‘下面再把EXCEL中的内容插入数据库
Dim UF As New System.Text.StringBuilder
DIM I AS INTEGER
Try
FOR I =0 TO DS.TABLES(0).ROWS.COUNT -1
UF.Append(" INSERT INTO table( ")
UF.Append(" FNumber ,")
UF.Append(" FName ,")
UF.Append(" FStatus) ")
UF.Append(" VALUES( ")
UF.Append(" '").Append(DS.TABLES(0).ROWS(I).ITEM(0)).Append("', ")
UF.Append(" '").Append(DS.TABLES(0).ROWS(I).ITEM(1)).Append("', ")
UF.Append(" '").Append(DS.TABLES(0).ROWS(I).ITEM(2)).Append("') ")
Debug.WriteLine("")
Debug.WriteLine(UF.ToString)
UFselect = New SqlClient.SqlCommand(UF.ToString, CNUF)
UFselect.CommandTimeout = 300
UFselect.ExecuteNonQuery()
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, "用友Error")
Exit Sub
End Try
NEXT
Private Sub Command1_Click()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\f1.xls;Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
cn.Execute "Insert Into [;database=" & App.Path & "\mydb2.mdb].[f2](id,item1,item2) Select id,item1,item2 From [Sheet1$]"
cn.Close
Set cn = Nothing
End Sub