my code stock.com

Sub para consumir webservice getfranquias, (necessário criar a tabela franquias primeiro)

Snippet options

Download: Download snippet as getfranquias.txt.
Copy snippet: For this you need a free my code stock.com account.
Embed code : You will find the embed code for this snippet at the end of the page, if you want to embed it into a website or a blog!

Public Function GetFranquias()
On Error GoTo ErrControl
Dim Webs As Object
Dim Franquias, chave, r
Dim Response As Object
Dim ssql As String
Dim i As Long, k As Long
Dim arrFields() As String
Dim strFields As String, strValues As String
    
    DoCmd.Hourglass True
    GetFranquias = False
    Debug.Print Time
    Set Webs = CreateObject("MSSOAP.SoapClient30")
    Webs.MSSoapInit "http://www.preparacursos.com.br/webservice/WSProdutos.asmx?wsdl"
    'http://www.preparacursos.com.br/webservice/WSProdutos.asmx?op=GetFranquias?wsdl
    Webs.ConnectorProperty("Timeout") = 300000
    Set Response = Webs.AutenticaUser("maestro", "maestrogilberto")
    chave = Response.Item(4).Text
    Franquias = Webs.GetFranquias(chave, "", "", "", "")
    If UBound(Franquias) > 0 Then
       For k = 0 To UBound(Franquias) - 1
            Set Response = Franquias(k)
            strFields = vbNullString
            strValues = vbNullString
            For Each r In Response
                If r.BaseName <> "type" Then
                    strFields = strFields & "[" & r.BaseName & "],"
                    strValues = strValues & "'" & Replace(r.Text, "'", "´") & "',"
                    'Debug.Print r.Text
                End If
            Next
            strFields = Left(strFields, Len(strFields) - 1)
            strValues = Left(strValues, Len(strValues) - 1)
            CurrentDb.Execute "Insert into tblFranquias (" & strFields & ") values (" & strValues & ")"
        Next k
    End If
    GetFranquias = True
    
Finally:
    Set Webs = Nothing
    Set Franquias = Nothing
    Set Response = Nothing
    Erase arrFields
    Debug.Print Time
    DoCmd.Hourglass False
    Exit Function
ErrControl:
    MsgBox "Erro: " & Err.Description, vbCritical, "AccessPro"
    Resume Finally
    
End Function

Create a free my code stock.com account now.

my code stok.com is a free service, which allows you to save and manage code snippes of any kind and programming language. We provide many advantages for your daily work with code-snippets, also for your teamwork. Give it a try!

Find out more and register now

You can customize the height of iFrame-Codes as needed! You can find more infos in our API Reference for iframe Embeds.