Function ConnectRst(Sql As String) As ADODB.Recordset
Dim Cnn As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;imex=1';data source=" & ThisWorkbook.FullName
Rst.Open Sql, Cnn, adOpenStatic
Set ConnectRst = Rst
End Function
好像由于adOpenStatic的原因,记录不能修改.
做了如下修改,也不行.
Rst.Open Sql, Cnn, adOpenDynamic, adLockBatchOptimisticSub ConnectPipeTableAndHG20617()
Dim Rst As ADODB.Recordset, Rst1 As ADODB.Recordset
Dim Sql As String
'Sql = "select WK,StandardNo,'法兰WN'& SIZE From [PipeTable$]"
Sql = "select trim(WK),StandardNo,'法兰WN'& DN & '-2.0 RF','316L', Dn,trim(SERVICE) From [按公称直径计算$] "
Sql = Sql & " Where StandardNo = 'HG20617'"
Set Rst = ConnectRst(Sql)
Dim Dn As Double, Pn As Double
With Rst
.MoveFirst
For ii = 0 To .RecordCount - 1
DDN = .Fields(4) '("Dn")
Pn = 2#
Sql = "Select 理论重量 from [Sheet1$] Where PN = '2.0' and DN = " & DDN
Set Rst1 = WithSqlReturnExcelRecordSet(Sql, ThisWorkbook.Path & "\HG20617")
llss = .Fields(4) '测试了为double
llss1 = Val(Rst1.Fields(0)) '转为Double
.Fields(4) = 11 'llss1 'Val(Rst1.Fields(0)) '此句不执行. '.Update (.Fields(4))
.MoveNext
Next ii
End With
With Sheets("PipeTable")
.Range("A:Z").ClearContents
.Range("A2").CopyFromRecordset Rst
End With
End Sub
Dim Cnn As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;imex=1';data source=" & ThisWorkbook.FullName
Rst.Open Sql, Cnn, adOpenStatic
Set ConnectRst = Rst
End Function
好像由于adOpenStatic的原因,记录不能修改.
做了如下修改,也不行.
Rst.Open Sql, Cnn, adOpenDynamic, adLockBatchOptimisticSub ConnectPipeTableAndHG20617()
Dim Rst As ADODB.Recordset, Rst1 As ADODB.Recordset
Dim Sql As String
'Sql = "select WK,StandardNo,'法兰WN'& SIZE From [PipeTable$]"
Sql = "select trim(WK),StandardNo,'法兰WN'& DN & '-2.0 RF','316L', Dn,trim(SERVICE) From [按公称直径计算$] "
Sql = Sql & " Where StandardNo = 'HG20617'"
Set Rst = ConnectRst(Sql)
Dim Dn As Double, Pn As Double
With Rst
.MoveFirst
For ii = 0 To .RecordCount - 1
DDN = .Fields(4) '("Dn")
Pn = 2#
Sql = "Select 理论重量 from [Sheet1$] Where PN = '2.0' and DN = " & DDN
Set Rst1 = WithSqlReturnExcelRecordSet(Sql, ThisWorkbook.Path & "\HG20617")
llss = .Fields(4) '测试了为double
llss1 = Val(Rst1.Fields(0)) '转为Double
.Fields(4) = 11 'llss1 'Val(Rst1.Fields(0)) '此句不执行. '.Update (.Fields(4))
.MoveNext
Next ii
End With
With Sheets("PipeTable")
.Range("A:Z").ClearContents
.Range("A2").CopyFromRecordset Rst
End With
End Sub
Rst.Open Sql, Cnn, adOpenStatic
改成
Rst.Open Sql, Cnn, adOpenDynamic
试试.
也可以把数据库发上来,我做做看