Problem with ActiveX VBa Code

  • I have the following code running correctly in VB. All the code and Databases are running locally On my pc. The code simply connects to a web site and returns via xml sms text message status details writing the results to a Sql table.

    When I place this code in to an ActiveX Dts Package and run the code I generate an error "ActiveX Scriptijng Function Not Defined"

    Help Please What am I doing that is wrong ?

    Suggestions Welcome

    Dim parameter1

    Dim parameter2

    Dim parameter3

    Dim parameter4

    Dim parameter5

    Dim parameter6

    Dim parameter7

    Dim parameter8

    Dim lReturnValue

    Dim sXmlString

    Dim xmlresponse

    Dim xmlrequest

    Dim sPassword

    Dim sUserName

    Dim sSelectedReport

    Dim sConnectString

    Dim cmdAdo

    Dim sResponse

    Dim iCounter

    Dim sDest

    Dim sStatus

    Dim vDateInsert

    Dim vDateAck

    Dim vDateSuccess

    Dim sMessageId

    Dim sGuid

    On Error Resume Next

    sConnectString = "PROVIDER=SQLOLEDB;DATA SOURCE=Andyd2k\dev3;DATABASE=AMC;USER ID=sa;PASSWORD=;"

    Set cn = CreateObject("ADODB.Connection")

    cn.ConnectionString = sConnectString

    cn.CursorLocation = adUseClient

    cn.open

    Set cmdAdo = CreateObject("ADODB.Command")

    Set cmdAdo.ActiveConnection = cn

    Set parameter1 = CreateObject("ADODB.parameter")

    Set parameter2 = CreateObject("ADODB.parameter")

    Set parameter3 = CreateObject("ADODB.parameter")

    Set parameter4 = CreateObject("ADODB.parameter")

    Set parameter5 = CreateObject("ADODB.parameter")

    Set parameter6 = CreateObject("ADODB.parameter")

    Set parameter7 = CreateObject("ADODB.parameter")

    Set parameter8 = CreateObject("ADODB.parameter")

    Set xmlrequest = CreateObject("MSXML2.XMLHTTP")

    sPassword = "mypassword" ' 2sms Account Password

    sUserName = "myaccount" ' 2sms Account Name

    sSelectedReport = "messagedetailstoday"

    sXmlString = "<?xml version=" & """" & "1.0" & """" & " encoding=" & """" & "UTF-8" & """" & "?> " & "<reportrequest>" & "<userid><![CDATA[" & sUserName & "]]></userid>" & "<password>" & sPassword & "</password>" & "<reporttype>" & sSelectedReport & "</reporttype>" & "<report>" & "<guid>" & txtGuid & "</guid>" & "<maxrecords>" & txtMaxRecords & "</maxrecords>" & "</report>" & "</reportrequest>"

    'sXmlString = "<?xml version=" & """" & "1.0" & """" & " encoding=" & """" & "UTF-8" & """" & "?> " & "<reportrequest>" & "<userid><![CDATA[" & sUserName & "]]></userid>" & "<password>" & sPassword & "</password>" & "<reporttype>" & sSelectedReport & "</reporttype>" & "<report>" & "<guid>" & txtGuid & "</guid>" & "<maxrecords>" & txtMaxRecords & "</maxrecords>" & "</report>" & "</reportrequest>"

    xmlrequest.open "post", "http://web.2sms.com/xmlreports/report.asp", False

    xmlrequest.setRequestHeader "content-type", "text/xml"

    xmlrequest.send sXmlString

    'Process Response

    Set xmlresponse = New Msxml2.DOMDocument30

    xmlresponse.resolveExternals = False

    sResponse = xmlrequest.responseText

    xmlresponse.loadXML sResponse

    'Find Out How Many Documents Returned

    iCounter = xmlresponse.getElementsByTagName("status").length

    If Not xmlresponse.parseError.reason <> "" Then

    For i = 0 To iCounter - 1

    If Not xmlresponse.getElementsByTagName("messageid").Item(i) Is Nothing Then

    sMessageId = xmlresponse.getElementsByTagName("messageid").Item(i).Text

    End If

    If Not xmlresponse.getElementsByTagName("guid").Item(i) Is Nothing Then

    sGuid = xmlresponse.getElementsByTagName("guid").Item(i).Text

    End If

    If Not xmlresponse.getElementsByTagName("destination").Item(i) Is Nothing Then

    sDest = xmlresponse.getElementsByTagName("destination").Item(i).Text

    End If

    If Not xmlresponse.getElementsByTagName("status").Item(i) Is Nothing Then

    sStatus = xmlresponse.getElementsByTagName("status").Item(i).Text

    End If

    If Not xmlresponse.getElementsByTagName("dateinsert").Item(i) Is Nothing Then

    vDateInsert = xmlresponse.getElementsByTagName("dateinsert").Item(i).Text

    End If

    If Not xmlresponse.getElementsByTagName("dateack").Item(i) Is Nothing Then

    vDateAck = xmlresponse.getElementsByTagName("dateack").Item(i).Text

    End If

    If Not xmlresponse.getElementsByTagName("datesuccess").Item(i) Is Nothing Then

    vDateSuccess = xmlresponse.getElementsByTagName("datesuccess").Item(i).Text

    End If

    Set parameter1 = cmdAdo.CreateParameter("@ReturnValue", adParamReturnValue, 4)

    Set parameter2 = cmdAdo.CreateParameter("@MsgId", adVarChar, adParamInput, 40, sMessageId & vbNullString)

    Set parameter3 = cmdAdo.CreateParameter("@Guid", adVarChar, adParamInput, 10, sGuid & vbNullString)

    Set parameter4 = cmdAdo.CreateParameter("@Destination", adVarChar, adParamInput, 20, sDestination & vbNullString)

    Set parameter5 = cmdAdo.CreateParameter("@Status", adVarChar, adParamInput, 40, sStatus & vbNullString)

    Set parameter6 = cmdAdo.CreateParameter("@DateInsert", adDBTimeStamp, adParamInput, 22, vDateInsert)

    If vDateAck = "" Or vDateAck = "null" Then

    vDateAck = Null

    End If

    Set parameter7 = cmdAdo.CreateParameter("@DateAck", adDBTimeStamp, adParamInput, 22, vDateAck)

    If vDateSuccess = "" Or vDateSuccess = "null" Then

    vDateSuccess = Null

    End If

    Set parameter8 = cmdAdo.CreateParameter("@DateSuccess", adDBTimeStamp, adParamInput, 22, vDateSuccess)

    cmdAdo.Parameters.Append parameter1

    cmdAdo.Parameters.Append parameter2

    cmdAdo.Parameters.Append parameter3

    cmdAdo.Parameters.Append parameter4

    cmdAdo.Parameters.Append parameter5

    cmdAdo.Parameters.Append parameter6

    cmdAdo.Parameters.Append parameter7

    cmdAdo.Parameters.Append parameter8

    cmdAdo.ActiveConnection = cn

    cmdAdo.CommandText = "sp_SmsStatusCrudq"

    cmdAdo.CommandType = adCmdStoredProc

    cmdAdo.Execute

    Set parameter1 = Nothing: Set parameter2 = Nothing: Set parameter3 = Nothing

    Set parameter4 = Nothing: Set parameter5 = Nothing: Set parameter6 = Nothing

    Set parameter7 = Nothing: Set parameter8 = Nothing: Set cmdAdo = Nothing

    Set cmdAdo = CreateObject("ADODB.Command")

    Set cmdAdo.ActiveConnection = cn

    Next

    End If

    Main = DTSTaskExecResult_Success

  • You need to declare your function at the top. At the bottom you are setting function Main = DTSTaskExecResult_Success, but there is no function header

  • Two things.

    First take out the ON ERROR RESUME NEXT or at least only use it when you want to trap a specific error and immediately do ON ERROR GOTO 0 when past that point. It is a bad practice to use it at the begining and not turn off, plus doing it as is makes it harder to troubleshoot issues.

    Remove all the code and put each line in one by one until you get the error again to find out what specifically it is barking about.

    Also, depedning on where you run this from, if executed on the server, do you have the XML parser installed?

    "Don't roll your eyes at me. I will tape them in place." (Teacher on Boston Public)

  • Your problem is probably on the line:-

    Set xmlresponse = New Msxml2.DOMDocument30

    You have to use CreateObject in VB Script rather than New

Viewing 4 posts - 1 through 3 (of 3 total)

You must be logged in to reply to this topic. Login to reply