Module ModCob

    Sub Main()



        Const adOpenStatic = 3
        Const adLockOptimistic = 3



        Dim objConnCli As ADODB.Connection
        Dim objConnV As ADODB.Connection
        Dim objConnCliUpdate As ADODB.Connection
        Dim objCli As ADODB.Recordset
        Dim Sqlstr
        Dim cCodCli
        Dim cNamCli
        Dim cObCli
        Dim inipos
        Dim endpos
        Dim nPosCap

        objConnCli = New ADODB.Connection
        objConnV = New ADODB.Connection
        objConnCliUpdate = New ADODB.Connection
        objCli = New ADODB.Recordset


        objConnCli.Open _
        ("Provider =SQLOLEDB; " & "Data Source =test\test,49729;" & "Initial Catalog='testdb';" & "User ID='users';Password='pass';")

        objConnV.Open _
        ("Provider =SQLOLEDB; " & "Data Source =test\test,49729;" & "Initial Catalog='testdb';" & "User ID='users';Password='pass';")

        objConnCliUpdate.Open _
        ("Provider =SQLOLEDB; " & "Data Source =test\test,49729;" & "Initial Catalog='testdb';" & "User ID='users';Password='pass';")

        Sqlstr = "SELECT * FROM Tclients"
        objCli.Open(Sqlstr, objConnCli, adOpenStatic, adLockOptimistic)

        Do Until objCli.EOF

            cCodCli = objCli.Fields.Item("Tclients1")
            cNamCli = objCli.Fields.Item("Tclients2")
            cObCli = objCli.Fields.Item("Tclient5")

            inipos = InStr(cObCli, "[/Fac:")
            endpos = InStr(cObCli, "/]")


            If endpos > 0 Then
                nPosCap = endpos + 2
            Else
                nPosCap = 1
            End If




            Dim cSQLQuery = "SELECT SUM(TVFACV2) FROM TVFACV WHERE TVFACV14='" & cCodCli & "' AND TVFACV4='N' AND TVFACV1<Date()"


            Dim objVen = objConnV.Execute(cSQLQuery)
            Dim NDCli
            NDCli = objVen(0).Value

            Dim cExtObCli = Mid(cObCli, nPosCap, 255)


            Dim cNewObCli
            Dim cSQLQueryUpdate

            If NDCli <> 0 Then
                cNewObCli = "(/Fac:  " & NDCli & " /)" & cExtObCli
            Else
                cNewObCli = cExtObCli
            End If


            cSQLQueryUpdate = "UPDATE Tclients SET Tclients23='" & cNewObCli & "',Tclients22=1,Tclients23=1 where Tclients1='" & cCodCli & "'"

            If Len(cNewObCli) <= 255 Then

                Dim objCliUpdate = objConnCliUpdate.Execute(cSQLQueryUpdate)
            End If

            objVen.Close

            objCli.MoveNext
        Loop

        objConnCli.Close
        objConnV.Close
        objConnCliUpdate.Close


    End Sub

End Module