7,765
社区成员
发帖
与我相关
我的任务
分享
Option Explicit '强制定义变量名
Public i As Long
Public n As Long
Public xlapp As Object 'Excel 对象
Public xlbook As Object '工作簿
Public xlsheet As Object '工作表
Public Function UpdateBom()
Set con = New ADODB.Connection
Set res = New ADODB.Recordset
con.Open "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "\Data.accdb"
Set xlapp = CreateObject("Excel.Application")
Set xlbook = xlapp.Workbooks.Open(SystemSet.DesignXL)
Set xlsheet = xlbook.Worksheets("任务表")
xlapp.Visible = False
GToS (DAT)
xlapp.Quit
If res.State = adStateOpen Then res.Close
If con.State = adStateOpen Then con.Close
Set xlapp = Nothing
Set res = Nothing
Set con = Nothing
End Function
Public Function GToS(ByVal DAT As String) As ADODB.Recordset '从工作表更新到数据库
n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
For i = 2 To n
SystemSet.Progress.Value = i
If xlsheet.Cells(i, 8) <> "" Then
res.Open "select * from 新油缸目录 where 编号='" & xlsheet.Cells(i, 1).Value & " '", con, 3, 3
res.Fields("型号") = xlsheet.Cells(i, 2).Value
res.Fields("类别") = xlsheet.Cells(i, 3).Value
res.Fields("设计") = xlsheet.Cells(i, 4).Value
res.Fields("时间") = xlsheet.Cells(i, 5).Value
res.Fields("信息") = xlsheet.Cells(i, 9).Value
res.Update
res.Close
xlsheet.Rows(CStr(i) & ":" & CStr(i)).Select
Selection.ClearContents
End If
Next i
xlsheet.Range("A2:M" & n).Sort key1:=xlsheet.Range("A2"), order1:=xlAscending
xlbook.Save
If res.State = adStateOpen Then res.Close
End Function
我只能做到这样了
Next i
Exit Do
'标准模块中代码:
Public con As New ADODB.Connection '定义一个数据连接New ADODB.
Public res As New ADODB.Recordset '定义一个数据集对象New ADODB.
Public Sub dbopen(dbmc As String) '定义一个公共主函数,用于连接数据库
Dim temp As String
temp = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & dbmc & ". accdb;Peresist Security Info=true"
con.Open (temp)
End Sub
Public Sub resclose(res As Recordset)
If res.State = adStateOpen Then
'打开
res.Close
Else
'
End If
End Sub
Public Sub dbclose(con As Connection)
If con.State = adStateOpen Then
con.Close
Else
End If
End Sub
'form load中代码:在软件启动时打开数据库
Private Sub Form_Load()
'关闭已打开的数据库
Call resclose(res)
Call dbclose(con)
'打开数据库
Call dbopen("Data")
End Sub
Private Sub Form_Unload(Cancel As Integer) '退出软件时才关闭数据库和记录集
Call resclose(res)
Call dbclose(con)
End
End Sub
'修改你的代码:
Public Function GToS(ByVal DT As String) As ADODB.Recordset '从工作表更新到数据库
On Error Resume Next
Set xlapp = CreateObject("Excel.Application")
Set xlbook = xlapp.Workbooks.Open(SystemSet.DesignXL)
Set xlsheet = xlbook.Worksheets("任务表")
xlapp.Visible = False
n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
YesNo = True
Do While YesNo
YesNo = False
For i = 2 To n
If xlsheet.Cells(i, 7).Value <> "" Then
'修改指定表中纪录
Set res = cn.Execute("UPDATE 目录 SET 类别='" + xlsheet.Cells(i, 3).Value + "', 设计='" + xlsheet.Cells(i, 4).Value + "', 信息='" + xlsheet.Cells(i, 9).Value + "' where 编号='"+ xlsheet.Cells(i, 1).Value +"'")
xlsheet.Rows(CStr(i) & ":" & CStr(i)).Select
Selection.Delete Shift:=xlUp
n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
YesNo = True
End If
Next i
Loop
xlbook.Close True
xlapp.Quit
Set xlapp = Nothing
End Function
你测试一下看看!!
Public cn As New ADODB.Connection '定义一个数据连接New ADODB.
Public rs As New ADODB.Recordset '定义一个数据集对象New ADODB.
'查询纪录
sql = "select * from tb_gys " + " order by 客户编码"
'打开记录集
Set rs = cn.Execute(sql)
s1=rs.Fields("设计")
'往指定表中添加新纪录
Set rs = cn.Execute("insert into tb_jljl(字段1,字段2) values(" & StrNum & ",'" & Text1(0).Text & "')")
'修改指定表中纪录
Set rs = cn.Execute("UPDATE tb_zcsz SET 字段1='" + txtFields(1).Text + "',字段2='" + txtFields(2).Text + "' where 字段1='"+"com"+"'")
'往指定表中添加新纪录
Set rs = cn.Execute("insert into tb_jljl(字段1,字段2) values(" & StrNum & ",'" & Text1(0).Text & "')")
'修改指定表中纪录
Set rs = cn.Execute("UPDATE tb_zcsz SET 字段1='" + txtFields(1).Text + "',字段2='" + txtFields(2).Text + "' where 字段1='"+"com"+"'")
使用SQL语句可能更好一点吧,,Public Function GToS(ByVal DT As String) As ADODB.Recordset '从工作表更新到数据库
Set con = New ADODB.Connection
Set res = New ADODB.Recordset
On Error Resume Next
Set xlapp = CreateObject("Excel.Application")
Set xlbook = xlapp.Workbooks.Open(SystemSet.DesignXL)
Set xlsheet = xlbook.Worksheets("任务表")
xlapp.Visible = False
con.Open "provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & App.Path & "\Data.accdb"
res.Open "select * from 目录", con, 3, 3
res.Close
n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
YesNo = True
Do While YesNo
YesNo = False
For i = 2 To n
If xlsheet.Cells(i, 7).Value <> "" Then
res.Open "select * from 目录 where 编号='" & xlsheet.Cells(i, 1).Value & " '", con, 3, 3
res.Fields("类别") = xlsheet.Cells(i, 3).Value
res.Fields("设计") = xlsheet.Cells(i, 4).Value
res.Fields("信息") = xlsheet.Cells(i, 9).Value
res.Update
res.Close
xlsheet.Rows(CStr(i) & ":" & CStr(i)).Select
Selection.Delete Shift:=xlUp
n = xlsheet.Cells(1, 1).CurrentRegion.Rows.Count
YesNo = True
End If
Next i
Loop
xlbook.Close True
xlapp.Quit
Set xlapp = Nothing
Set res = Nothing
Set con = Nothing
End Function
这段程序我是参考了别人的改的,不知道是不是很麻烦或有错误,请帮我