文件路径在文本框txtPath中已经附值，如：“C:\ddd\aa\c.xls”,现在希望做的是点“确定”按钮后能把这个表格中的数据导入到数据库表DMXX中。DMXX的表结构是：ID，WID，YDM，YM。ID和WID是联合主键。在导入数据的时候，ID是附一个固定值，如12，WID是从1开始的流水号，YDM字段的数据对应EXCEL表第一列的数据，YM字段的数据对应EXCEL表的第二列的数据。
小弟是新手，很多专业术语和控件也不太明白，麻烦各位高手帮忙写一个完整的方法，如果要做什么设置也麻烦解释一下，非常感谢！！
小弟是新手，很多专业术语和控件也不太明白，麻烦各位高手帮忙写一个完整的方法，如果要做什么设置也麻烦解释一下，非常感谢！！
要不就是用一条一条对应的插入到数据库中 这样比较麻烦 没有这样用过
Dim xlapp As Excel.Application, l_set As Recordset, i As Integer, l_sum As Integer, j As Integer
Dim strsource As String, strdestination As String, l_row As Integer
Dim l_sheets As Integer, l_re_counts As Integer
Set xlapp = New Excel.Application
Set xlapp = CreateObject("excel.application")
FileCopy g_cuspath & "\provider_sum.xls", g_cuspath & "\provider_sum.xls_temp.xls"
Set XLBOOK = xlapp.Workbooks.Open(g_cuspath & "\provider_sum.xls_temp.xls")
If i_pici > 23 Then
l_sheets = 1
l_re_counts = i_pici
f_row = 23
Adodc1.Recordset.MoveFirst
Do
i = 6
j = 1
i_yw = 0
i_bhg = 0
Set XLSHEET = XLBOOK.Worksheets(l_sheets)
XLSHEET.Cells(3, 1) = "供应商名称:" & T_p_name.Text
Do While j <= f_row
XLSHEET.Cells(i, 1) = Trim(Adodc1.Recordset("ll_date"))
XLSHEET.Cells(i, 2) = Adodc1.Recordset("stock_code")
XLSHEET.Cells(i, 3) = Adodc1.Recordset("xingneng")
Select Case Adodc1.Recordset("pinming")
Case "m"
XLSHEET.Cells(i, 4) = "√"
Case "p"
XLSHEET.Cells(i, 6) = "√"
End Select
XLSHEET.Cells(i, 7) = Adodc1.Recordset("guige")
XLSHEET.Cells(i, 8) = Adodc1.Recordset("dh_shu")
XLSHEET.Cells(i, 9) = Trim(Adodc1.Recordset("deliver_date"))
If IsNull(Trim(Adodc1.Recordset("dh_detail"))) Then
XLSHEET.Cells(i, 10) = "?"
Else
If IsNumeric(Adodc1.Recordset("dh_detail")) Then
If CInt(Adodc1.Recordset("dh_detail")) < -7 Then
XLSHEET.Cells(i, 10) = "×"
i_yw = i_yw + 1
Else
XLSHEET.Cells(i, 10) = "√"
End If
Else
If Trim(Adodc1.Recordset("dh_detail")) = "准时" Then
XLSHEET.Cells(i, 10) = "√"
Else
XLSHEET.Cells(i, 10) = "×"
i_yw = i_yw + 1
End If
End If
End If
If IsNull(Trim(Adodc1.Recordset("zz_panding"))) Then
XLSHEET.Cells(i, 11) = "?"
Else
If Adodc1.Recordset("zz_panding") = "合格" Then
XLSHEET.Cells(i, 11) = "√"
Else
XLSHEET.Cells(i, 12) = "×"
i_bhg = i_bhg + 1
End If
End If
If Adodc1.Recordset("zz_panding") = "特采" Then
XLSHEET.Cells(i, 13) = "特采"
End If
XLSHEET.Cells(i, 14) = G_OPER
i = i + 1
j = j + 1
Adodc1.Recordset.MoveNext
Loop
XLSHEET.Cells(29, 2) = CStr(f_row)
XLSHEET.Cells(29, 8) = CStr(i_yw)
XLSHEET.Cells(29, 13) = CStr(i_bhg)
l_re_counts = l_re_counts - 23
l_sheets = l_sheets + 1
If l_re_counts > 23 Then
f_row = 23
Else
f_row = l_re_counts
End If
Loop Until l_re_counts <= 0
Else
f_row = i_pici
Set XLSHEET = XLBOOK.Worksheets(1)
XLSHEET.Cells(3, 1) = "供应商名称:" & T_p_name.Text
i = 6
j = 1
i_yw = 0
i_bhg = 0
Adodc1.Recordset.MoveFirst
Do While j <= f_row
XLSHEET.Cells(i, 1) = Trim(Adodc1.Recordset("ll_date"))
XLSHEET.Cells(i, 2) = Adodc1.Recordset("stock_code")
XLSHEET.Cells(i, 3) = Adodc1.Recordset("xingneng")
Select Case Adodc1.Recordset("pinming")
Case "m"
XLSHEET.Cells(i, 4) = "√"
Case "p"
XLSHEET.Cells(i, 6) = "√"
End Select
XLSHEET.Cells(i, 7) = Adodc1.Recordset("guige")
XLSHEET.Cells(i, 8) = Adodc1.Recordset("dh_shu")
XLSHEET.Cells(i, 9) = Trim(Adodc1.Recordset("deliver_date"))
If IsNull(Trim(Adodc1.Recordset("dh_detail"))) Then
XLSHEET.Cells(i, 10) = "?"
Else
If IsNumeric(Adodc1.Recordset("dh_detail")) Then
If CInt(Adodc1.Recordset("dh_detail")) < -7 Then
XLSHEET.Cells(i, 10) = "×"
i_yw = i_yw + 1
Else
XLSHEET.Cells(i, 10) = "√"
End If
Else
If Trim(Adodc1.Recordset("dh_detail")) = "准时" Then
XLSHEET.Cells(i, 10) = "√"
Else
XLSHEET.Cells(i, 10) = "×"
i_yw = i_yw + 1
End If
End If
End If
If IsNull(Trim(Adodc1.Recordset("zz_panding"))) Then
XLSHEET.Cells(i, 11) = "?"
Else
If Adodc1.Recordset("zz_panding") = "合格" Then
XLSHEET.Cells(i, 11) = "√"
Else
XLSHEET.Cells(i, 12) = "×"
i_bhg = i_bhg + 1
End If
End If
If Adodc1.Recordset("zz_panding") = "特采" Then
XLSHEET.Cells(i, 13) = "特采"
End If
XLSHEET.Cells(i, 14) = G_OPER
i = i + 1
j = j + 1
Adodc1.Recordset.MoveNext
Loop
XLSHEET.Cells(29, 2) = CStr(f_row)
XLSHEET.Cells(29, 8) = CStr(i_yw)
XLSHEET.Cells(29, 13) = CStr(i_bhg)
End If
xlapp.Visible = True
End Function
Dim rs As New Recordset
cn.ConnectionString = "连接字符串(此处省略N个字)"
cn.Open
strSql = "select * from sysobjects where [name]='[Sheet1$]'"
'查询SQL库里是否有这个表
Rst.Open strSql, Cn, adOpenKeyset, adLockPessimistic
if rst.recordcout<>0 then
'有表时
cn.execute "DROP TABLE [Sheet1$]"
'删除他
endif
rst.close cn.Execute "select * into invest1 from OpenRowSet('microsoft.jet.oledb.4.0','Excel 8.0;HDR=Yes;database=CommonDialog1.FileName;','select * from [Sheet1$]')"嘎嘎。应用楼上的东西
Set XLBOOK = xlapp.Workbooks.Open(g_cuspath & "\provider_sum.xls_temp.xls")还有Adodc1.Recordset.MoveFirst ,是不是要放个adodc控件啊?
小生老师能把含有这个函数的程序源码发给我吗?还有对应一个EXCEl表格是不是?.谢谢了~~
你的是Access 这个方法就不行了
Dim cn As New ADODB.Connection '连接execl
Dim con As New ADODB.Connection '连接access
Dim rs As New Recordset '存储execl中的数据
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\My Vbp\MyDataBase\DataBase.mdb;Persist Security Info=False"'连接Access数据库,Data Source换成自己的数据库位置
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=false;Data Source=C:\Documents and Settings\zhangshuai\My Documents\My Work\ExeclToSQL.xls;Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
'连接Execl数据库,Data Source换成自己的数据库位置,为了通用可以用通用对话框得到Execl的路径 我这里就不写了 cn.Open
con.Open
rs.Open "select * From [Sheet1$]", cn, 1, 1'读取Execl中Sheet1的数据
If rs.EOF = True Then'判断是否为空
Exit Sub
End If
While Not rs.EOF'将RS中存储的Execl数据插入到Access中去.
con.Execute "Insert Into TableName(Name)Values('" & rs(0) & "')"
'TabelName是表名 Name时列名要导入那个列就写那个列 Values('" & rs(0) & "')是对应的Execl中的数据，要对应好
rs.MoveNext
Wend
rs.Close
cn.Close
con.Close
Set rs = Nothing
Set cn = Nothing
End Sub