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"
Pergunta
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
Link para o comentário
Compartilhar em outros sites
0 respostass a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.