不能手动或分布事务方式下创建新的连接

代码挺多,简单概括如下:
采用事务,如果把事务语句去掉,程序可以执行,但是
加上事务就出现:"不能手动或分布事务方式下创建新的连接" 的错误
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim rs3 As New ADODB.Recordset
Dim rs4 As New ADODB.Recordset
Dim rs5 As New ADODB.Recordset

cnn.ConnectionString = "Provider=SQLOLEDB;" _
& "server=127.0.0.1;" _
& "User ID=sa;" _
& "Password =qwe;" _
& "DNS=power_mis;" _
& "Initial Catalog =cpk"
cnn.Open
On Error GoTo err_proc
cnn.BeginTrans
sql = "select * from T1" "
rs.Open sql, cnn, 3, 2
SQL1 = "select * from T2"
rs1.Open SQL1, cnn, 3, 2
SQL2 = "select * from T3"
rs2.Open SQL2, cnn, 3, 2
SQL3 = "select * from T3"
rs3.Open SQL3, cnn, 3, 2
'下面是判断
if rs.RecordCount =0 then
.....
else
if rs1.RecordCount =0 then
..........
else
if rs2.RecordCount=0 then
......
else
if rs3.RecordCount =0 then
.......
else

sql4="update T5 set ...."
cnn.Execute sql4
sql5="update T6 set ...."
cnn.Execute sql5
sql6="insert into....."
cnn.Execute sql6
cnn.CommitTrans
rs.Close
rs1.Close
rs2.Close
rs3.Close
Set rs = Nothing
Set rs1 = Nothing
Set rs2 = Nothing
Set rs3 = Nothing
cnn.Close
Set cnn = Nothing
exit Sub
end if
end if
end if
end if
cnn.RollbackTrans
MsgBox Err.Description
MsgBox "出现错误保存失败!,请重新操作", 48, "提示"
Exit Sub