Problem to come out of the Main Function in Active

Please start any new threads on our new site at https://forums.sqlteam.com. We've got lots of great SQL Server experts to answer whatever question you can come up with.

All Forums

SQL Server 2000 Forums

Import/Export (DTS) and Replication (2000)

Problem to come out of the Main Function in Active

Author

Topic

shikhajain25
Starting Member

1 Post

Posted - 2005-01-18 : 01:26:14

Hi All,
I am facing a problem in my this script where i have to fetch some values from Access and then there corresponding values in SQL Server tables and load in a Text File.
But, when i try this code in VB Editor it runs perfectly Fine.....
But in DTS It is going in an indefinate loop
But, when i say explicitly Exit Function then it throws an error!!!
Can you pls help and guide me where i am facing problem.
Thanks and Warm Regards,
Shikha Jain
Conversion-Team
'**********************************************************************
' Visual Basic Transformation Script
'************************************************************************

' Copy each source column to the destination column
Function Main()
Call Code
'Exit Function''If this is used it throws error
'Now it will go inside an indefinate loop.

'Main = DTSTaskExecResult_Success
Main = DTSTransformStat_OK
End Function

Sub Code
msgbox"Entered Code procedure"

Dim Cnn
Dim Cnn1
Dim ObjCon
Dim ObjCmdContractId
Dim ObjCmdPartyId
Dim ObjRsContractId
Dim ObjRsPartyId
Dim ObjCmdEdgeUserId
Dim ObjRsEdgeUserId
Dim Cnt
Dim ICPartyId
Dim PartyId
Dim ClientBusnPartId
Dim objFSO1
Dim objFSO2
Dim objStream1
Dim objStream2
Const OUTPUT_FILE1 = "C:\MasterContractStatic\Errors_PartyId.txt"
Const OUTPUT_FILE2 = "C:\MasterContractStatic\Errors_ClientBusnPartId.txt"
Const fsoForWriting = 2

Set objFSO1 = CreateObject("Scripting.FileSystemObject")
'MsgBox "Created a PartyId File Object"
Set objStream1 = objFSO1.OpenTextFile(OUTPUT_FILE1, fsoForWriting, True)
'MsgBox "Opened a Output Error-PartyId Log File"

Set objFSO2 = CreateObject("Scripting.FileSystemObject")
'MsgBox "Created a PartyId File Object"
Set objStream2 = objFSO2.OpenTextFile(OUTPUT_FILE2, fsoForWriting, True)
'MsgBox "Opened a Output Error-Edge User Id Log File"

Set Cnn = CreateObject("ADODB.Connection")

Cnn.connectionstring = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=OD1Test;pwd=OD1Test;Initial Catalog=Edge_Staging;Data Source=WB10f059"
Cnn.Open

Set Cnn1 = CreateObject("ADODB.Connection")

Cnn1.connectionstring = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=OD1Test;pwd=OD1Test;Initial Catalog=Edge_Legacy_Xref;Data Source=WB10f059"
Cnn1.Open

Set ObjCon = CreateObject("ADODB.Connection")

'MsgBox "Created Access Connection"

ObjCon.CursorLocation = 3 'adUseClient
ObjCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=c:\MastercontractStatic\MasterContract.mdb;" & _
"User Id=admin;" & _
"Password="

'MsgBox "Open Access Connection"

Set ObjCmdContractId = CreateObject("ADODB.Command")
ObjCmdContractId.ActiveConnection = ObjCon
ObjCmdContractId.CommandType = 1 'adCmdText
ObjCmdContractId.CommandText = "SELECT ContractId,ICPartyOID FROM tblBusnPartClientSuppContract"

'MsgBox "set command access"

Set ObjCmdPartyId = CreateObject("ADODB.Command")
ObjCmdPartyId.ActiveConnection = Cnn
ObjCmdPartyId.CommandType = 1 'adCmdText
' ObjCmdPartyId.CommandText = "SELECT PartyId FROM IC2_CLIENT "
'MsgBox "Set command Party Id SQL Server"

Set ObjCmdEdgeUserId = CreateObject("ADODB.Command")
ObjCmdEdgeUserId.ActiveConnection = Cnn1
ObjCmdEdgeUserId.CommandType = 1 'adCmdText
' ObjCmdEdgeUserId.CommandText = "SELECT EdgeUserId FROM tblEdgeLegacyUserXref"
'MsgBox "Set command EdgeUserID SQL Server"

Set ObjRsContractId = CreateObject("ADODB.Recordset")
Set ObjRsContractId = ObjCmdContractId.Execute

'MsgBox "SetCreated Access Recordset"

Set ObjRsPartyId = CreateObject("ADODB.Recordset")
'Set ObjRsPartyId = ObjCmdPartyId.Execute

'MsgBox "Created SQL Server PartyId Recordset"
Set ObjRsEdgeUserId = CreateObject("ADODB.Recordset")
'Set ObjRsEdgeUserId = ObjCmdEdgeUserId.Execute

'MsgBox "Created SQL Server Edge User Id Recordset"

Do While Not ObjRsContractId.EOF

'Msgbox ObjRsContractId("ContractId").Value
ICPartyId = ObjRsContractId("ICPartyOID").Value

'MsgBox "stored ICPartyOID in a variable"

' Set ObjRsPartyId = ObjCmdPartyId.Execute

ObjRsPartyId.Open "SELECT PartyId FROM IC2_CLIENT WHERE DivNo=000 AND ClientNo= " & ICPartyId, Cnn

If (ObjRsPartyId.BOF = True And ObjRsPartyId.EOF = True) Or (ObjRsPartyId.RecordCount = 0) Then
PartyId = ICPartyId
objStream1.WriteLine (PartyId)
objStream1.WriteBlankLines (1)
'MsgBox "Entered Wrong Party Id in the Error File"
'Exit Do
ObjRsPartyId.Close
'ObjRsEdgeUserId.Close
Else
PartyId = ObjRsPartyId("PartyId").Value

'MsgBox "SELECT PartyId FROM Client table WHERE DivNo=000 AND ClientNo= " & ICPartyId

ObjRsEdgeUserId.Open "SELECT EdgeUserId FROM tblEdgeLegacyUserXref WHERE LegacyUserTypeCd=15 AND ICPartyId= " & PartyId, Cnn1
If (ObjRsEdgeUserId.BOF = True And ObjRsEdgeUserId.EOF = True) Or (ObjRsEdgeUserId.RecordCount = 0) Then
ClientBusnPartId = PartyId
objStream2.WriteLine (ClientBusnPartId)
objStream2.WriteBlankLines (1)
'Exit Do
Else
ClientBusnPartId = ObjRsEdgeUserId("EdgeUserId").Value
End If
'MsgBox "SELECT EdgeUserId FROM tblEdgeLegacyUserXref WHERE LegacyUserTypeCd=15 AND ICPartyId= " & PartyId
'MsgBox ClientBusnPartId
'MsgBox "stored ClientBusnPartId in a variable"

ObjRsPartyId.MoveNext
ObjRsEdgeUserId.MoveNext
ObjRsPartyId.Close
ObjRsEdgeUserId.Close

End If

DTSDestination("ContractId") = ObjRsContractId("ContractId").Value+DTSGlobalVariables("maxObjContractid").Value
DTSDestination("ClientBusnPartId") = ClientBusnPartId
DTSDestination("CreateId") = 1
DTSDestination("CreateDt") = NOW
DTSDestination("UpdateId") = 1
DTSDestination("UpdateDt") = NOW
DTSDestination("FunctionId") = 1
DTSDestination("AppId") = "OD1-Conv"
DTSDestination("DBAPartitionKey") = 1

'MsgBox "Reached last :-Entered client Successfully"
ObjRsContractId.MoveNext

Loop

ObjRsContractId.Close

If ObjRsPartyId.Open = True Then
ObjRsPartyId.Close
End If

If ObjRsEdgeUserId.Open= True Then
ObjRsEdgeUserId.Close
End If

Set ObjRsContractId = Nothing
Set ObjRsPartyId = Nothing
Set ObjRsEdgeUserId = Nothing
Set ObjCmdContractId = Nothing
Set ObjCmdPartyId = Nothing
Set ObjCmdEdgeUserId = Nothing
Set ObjCon = Nothing
Set Con = Nothing
Set Con1 = Nothing

MsgBox "done"
Exit Sub

End Sub

Subscribe to SQLTeam.com

SQLTeam.com Articles via RSS

SQLTeam.com Weblog via RSS

- Advertisement -

Resources