Problema com MsxMl

[Nephisto]

Ola Pessoal, uso o Vb6 e estou tendo problema com a rotina q esta logo abaixo, principalmente com a parte do objXMLDOM.async = False, fico grato pela ajuda.

'--------ROTINA

Private Sub Command1_Click()

' On Error GoTo TrataErro

Dim objXMLHTTP As New MSXML2.XMLHTTP

Dim objXMLDOM As New MSXML2.DOMDocument26

Dim sConteudo As String

Dim sIE As String

Dim sCNPJ As String

Dim sCategoria As String

Dim sCNAE As String

Dim sUF As String

Dim sSituacao As String

Dim sDataInicio As String

Dim sDataBaixa As String

Dim sStatus As String

Dim sMsgErro As String

Dim sCPFtitular As String

Dim sTipoEstab As String

Dim sQuantidade As String

Dim sTipoPessoa As String

Dim sVinculo As String

If Trim(txtCPF) = "" Then

MsgBox "Informe o CPF do usuário!", vbExclamation + vbOKOnly, "Atenção"

txtCPF.SetFocus

Exit Sub

End If

If Trim(txtSenha) = "" Then

MsgBox "Informe a Senha do usuário!", vbExclamation + vbOKOnly, "Atenção"

txtSenha.SetFocus

Exit Sub

End If

' Informar apenas um dos 3 campos

If Trim(txtIE) <> "" And Trim(txtCNPJ) <> "" And Trim(txtCPFtitular) <> "" Or _

Trim(txtIE) <> "" And Trim(txtCNPJ) <> "" Or _

Trim(txtIE) <> "" And Trim(txtCPFtitular) <> "" Or _

Trim(txtCNPJ) <> "" And Trim(txtCPFtitular) <> "" Then

MsgBox "Informe somente a IE, ou somente o CNPJ, ou somente o CPF do titular.", vbExclamation + vbOKOnly, "Atenção"

txtCPFtitular.SetFocus

Exit Sub

End If

'------------------------------------------------------'

' 1ª parte - Envia um documento XML para o Web Service '

'------------------------------------------------------'

'Monta o documento XML conforme a estrutura definida para este Web Service

sConteudo = ""

sConteudo = sConteudo & "<PARAMETROS>"

sConteudo = sConteudo & " <CPF>" & Right("00000000000" & Trim(txtCPF), 11) & "</CPF>"

sConteudo = sConteudo & " <SENHA>" & txtSenha & "</SENHA>"

sConteudo = sConteudo & " <IE>" & Right("0000000000" & Trim(txtIE), 10) & "</IE>"

sConteudo = sConteudo & " <CNPJ>" & Right("00000000000000" & Trim(txtCNPJ), 14) & "</CNPJ>"

sConteudo = sConteudo & " <CPFTITULAR>" & Right("00000000000" & Trim(txtCPFtitular), 11) & "</CPFTITULAR>"

sConteudo = sConteudo & "</PARAMETROS>"

'Converte para um documento XML no padrão DOM

MsgBox sConteudo

objXMLDOM.async = False

objXMLDOM.loadXML (sConteudo)

'Aponta para o Web Service

objXMLHTTP.open "POST", "http://webservices.sefaz.rs.gov.br/CadastroContribuintesRSGeral_XML.asp", False

'Envia o documento XML para o Web Service

objXMLHTTP.send (objXMLDOM.xml)

'-----------------------------------------'

' 2ª parte - Recebe um XML do Web Service '

'-----------------------------------------'

Dim sRetorno As String

Dim objNodes As MSXML2.IXMLDOMNodeList

Dim objBookNode As MSXML2.IXMLDOMNode

Dim objBookNodeEMP As MSXML2.IXMLDOMNode

Set objNodes = objXMLDOM.selectNodes("PARAMETROS")

Set objNodesEMP = objXMLDOM.selectNodes("PARAMETROS/EMPRESA")

Dim aOCORRENCIA(5) As String

Dim aIEDUP(5) As String

Dim aNOMEDUP(5) As String

Dim aSITDUP(5) As String

Dim aTIPODUP(5) As String

Dim aVINCULODUP(5) As String

Dim ind As Integer

ind = 0

'Aqui é carregado o retorno do Web Service.

sRetorno = objXMLHTTP.responseXML.xml

objXMLDOM.async = False

objXMLDOM.loadXML (sRetorno)

'Percorre o documento XML recebido do Web Service

For Each objBookNode In objNodes

If objBookNode.selectNodes("IE").length <> 0 Then

sIE = objBookNode.selectSingleNode("IE").nodeTypedValue

End If

If objBookNode.selectNodes("CNPJ").length <> 0 Then

sCNPJ = objBookNode.selectSingleNode("CNPJ").nodeTypedValue

End If

If objBookNode.selectNodes("CPFTITULAR").length <> 0 Then

sCPFtitular = objBookNode.selectSingleNode("CPFTITULAR").nodeTypedValue

End If

If objBookNode.selectNodes("CATEGORIA").length <> 0 Then

sCategoria = objBookNode.selectSingleNode("CATEGORIA").nodeTypedValue

End If

If objBookNode.selectNodes("DATAINICIO").length <> 0 Then

sDataInicio = objBookNode.selectSingleNode("DATAINICIO").nodeTypedValue

End If

If objBookNode.selectNodes("DATABAIXA").length <> 0 Then

sDataBaixa = objBookNode.selectSingleNode("DATABAIXA").nodeTypedValue

End If

If objBookNode.selectNodes("SITUACAO").length <> 0 Then

sSituacao = objBookNode.selectSingleNode("SITUACAO").nodeTypedValue

End If

If objBookNode.selectNodes("TIPOESTAB").length <> 0 Then

sTipoEstab = objBookNode.selectSingleNode("TIPOESTAB").nodeTypedValue

End If

If objBookNode.selectNodes("QUANTIDADE").length <> 0 Then

sQuantidade = objBookNode.selectSingleNode("QUANTIDADE").nodeTypedValue

End If

If objBookNode.selectNodes("TIPOPESSOA").length <> 0 Then

sTipoPessoa = objBookNode.selectSingleNode("TIPOPESSOA").nodeTypedValue

End If

If objBookNode.selectNodes("VINCULO").length <> 0 Then

sVinculo = objBookNode.selectSingleNode("VINCULO").nodeTypedValue

End If

If objBookNode.selectNodes("CNAE").length <> 0 Then

sCNAE = objBookNode.selectSingleNode("CNAE").nodeTypedValue

End If

If objBookNode.selectNodes("UF").length <> 0 Then

sUF = objBookNode.selectSingleNode("UF").nodeTypedValue

End If

If objBookNode.selectNodes("STATUS").length <> 0 Then

sStatus = objBookNode.selectSingleNode("STATUS").nodeTypedValue

End If

If objBookNode.selectNodes("MSGERRO").length <> 0 Then

sMsgErro = objBookNode.selectSingleNode("MSGERRO").nodeTypedValue

End If

If objBookNode.selectNodes("EMPRESA").length <> 0 Then

For Each objBookNodeEMP In objNodesEMP

ind = ind + 1

If ind < 6 Then 'Só mostraremos os 5 primeiros estabelecimentos

If objBookNodeEMP.selectNodes("IEDUP").length <> 0 Then

aIEDUP(ind) = objBookNodeEMP.selectSingleNode("IEDUP").nodeTypedValue

End If

If objBookNodeEMP.selectNodes("NOMEDUP").length <> 0 Then

aNOMEDUP(ind) = objBookNodeEMP.selectSingleNode("NOMEDUP").nodeTypedValue

End If

If objBookNodeEMP.selectNodes("SITDUP").length <> 0 Then

aSITDUP(ind) = objBookNodeEMP.selectSingleNode("SITDUP").nodeTypedValue

End If

If objBookNodeEMP.selectNodes("TIPODUP").length <> 0 Then

aTIPODUP(ind) = objBookNodeEMP.selectSingleNode("TIPODUP").nodeTypedValue

End If

If objBookNodeEMP.selectNodes("VINCULODUP").length <> 0 Then

aVINCULODUP(ind) = objBookNodeEMP.selectSingleNode("VINCULODUP").nodeTypedValue

End If

End If

Next

End If

Next objBookNode

If sStatus = "01" Or sStatus = "02" Then

' Este Web Service retorna na variável Status:

' 01 - para inconsistência nos dados digitados

' 02 - para erro de comunicação com o Web Service

txtResult = IIf(sStatus = "01", "INCONSISTÊNCIA: ", "ERRO: ") & sMsgErro

Else

If sTipoEstab <> "DUPLO" Then

' Apresenta os dados da empresa recebidos do Web Service

txtResult = ""

txtResult = txtResult & "IE: " & Mid(sIE, 1, 3) & "/" & Mid(sIE, 4) & vbNewLine

txtResult = txtResult & "CNPJ: " & Mid(sCNPJ, 1, 2) & "." & _

Mid(sCNPJ, 3, 3) & "." & _

Mid(sCNPJ, 6, 3) & "/" & _

Mid(sCNPJ, 9, 4) & "-" & _

Mid(sCNPJ, 13, 2) & vbNewLine

txtResult = txtResult & "CPF do Titular: " & Mid(sCPFtitular, 1, 3) & "." & _

Mid(sCPFtitular, 4, 3) & "." & _

Mid(sCPFtitular, 7, 3) & "-" & _

Mid(sCPFtitular, 10, 2) & vbNewLine

txtResult = txtResult & "Quantidade: " & sQuantidade & vbNewLine

txtResult = txtResult & "Tipo de Estabelecimento: " & sTipoEstab & vbNewLine

txtResult = txtResult & "Tipo de Pessoa: " & IIf(sTipoPessoa = "J", "JURÍDICA", IIf(sTipoPessoa = "F", "FÍSICA", "")) & vbNewLine

txtResult = txtResult & "Categoria: " & sCategoria & vbNewLine

txtResult = txtResult & "CNAE-Fiscal: " & sCNAE & vbNewLine

txtResult = txtResult & "UF: " & sUF & vbNewLine

txtResult = txtResult & "Tipo de Vínculo: " & sVinculo & vbNewLine

txtResult = txtResult & "Situação: " & sSituacao & vbNewLine

txtResult = txtResult & "Data de início: " & sDataInicio & vbNewLine

txtResult = txtResult & "Data da baixa: " & sDataBaixa

DoEvents

Else

' Apresenta os dados da empresa recebidos do Web Service

txtResult = ""

txtResult = txtResult & "IE: " & Mid(sIE, 1, 3) & "/" & Mid(sIE, 4) & vbNewLine

txtResult = txtResult & "CNPJ: " & Mid(sCNPJ, 1, 2) & "." & _

Mid(sCNPJ, 3, 3) & "." & _

Mid(sCNPJ, 6, 3) & "/" & _

Mid(sCNPJ, 9, 4) & "-" & _

Mid(sCNPJ, 13, 2) & vbNewLine

txtResult = txtResult & "CPF do Titular: " & Mid(sCPFtitular, 1, 3) & "." & _

Mid(sCPFtitular, 4, 3) & "." & _

Mid(sCPFtitular, 7, 3) & "-" & _

Mid(sCPFtitular, 10, 2) & vbNewLine

txtResult = txtResult & "Tipo de Estabelecimento: " & sTipoEstab & vbNewLine

txtResult = txtResult & "Quantidade: " & sQuantidade & vbNewLine

For f = 1 To ind

If f > 5 Then 'Só mostraremos os 5 primeiros estabelecimentos

Exit For

End If

txtResult = txtResult & "-(" & f & ")" & String(30, "-") & vbNewLine

txtResult = txtResult & "IE: " & Mid(aIEDUP(f), 1, 3) & "/" & Mid(aIEDUP(f), 4) & vbNewLine

txtResult = txtResult & "Nome: " & aNOMEDUP(f) & vbNewLine

txtResult = txtResult & "Situação: " & IIf(aSITDUP(f) = "A", "ATIVA", IIf(aSITDUP(f) = "B", "BAIXADA", "")) & vbNewLine

txtResult = txtResult & "Tipo de Estabelecimento: " & aTIPODUP(f) & vbNewLine

txtResult = txtResult & "Tipo de Vínculo: " & aVINCULODUP(f) & vbNewLine

Next

End If

End If

'Seleciona o campo que foi preenchido na última consulta

If Trim(txtIE) <> "" Then

txtIE.SelStart = 0

txtIE.SelLength = 10

txtIE.SetFocus

Else

If Trim(txtCNPJ) <> "" Then

txtCNPJ.SelStart = 0

txtCNPJ.SelLength = 14

txtCNPJ.SetFocus

Else

txtCPFtitular.SelStart = 0

txtCPFtitular.SelLength = 14

txtCPFtitular.SetFocus

End If

End If

Exit Sub

'TrataErro:

' MsgBox Err.Description

' End

End Sub