MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Rotina para baixar NFe...

    Compartilhe

    johnaccess
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 6
    Registrado : 01/11/2010

    Rotina para baixar NFe...

    Mensagem  johnaccess em Ter 31 Jan 2017, 09:49

    A título de informação, segue um código para baixar NFe...
    Caso alguém faça melhorias, por favor, envie me.


    Option Compare Database

    Public Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

    'call abrirsite("32160881106957000208550010001541031008151705")
    Function AbrirSite(sChave As String)
    On Error GoTo AbrirSite_Error
    Dim msg As String, objIE As InternetExplorer, elem, tbl, tr
    Dim sJanela As Long, nJanela As String
    nJanela = "https://www.fsist.com.br/?PortalAlternativo - FSist - Download XML e PDF NFe/CTe - Internet Explorer"
    Set objIE = CreateObject("InternetExplorer.Application")
    With objIE
    .StatusBar = False
    .Toolbar = False
    .Width = 800
    .Height = 600
    .Resizable = False
    .AddressBar = False
    .Visible = True
    .Top = 60
    .Left = 560
    .Navigate "https://www.fsist.com.br/?PortalAlternativo"
    Sleep (3000)
    .Document.all.Item("chave").innerText = sChave
    Sleep (3000)
    .Document.all("butProximo").Click
    Sleep (3000)
    .Document.getElementById("captcha").Focus
    .Document.all.Item("captcha").innerText = "123456"
    Sleep (3000)
    .Document.getElementById("captcha").Focus
    Sleep (3000)
    sJanela = FindWindow(vbNullString, nJanela)
    If sJanela <> 0 Then
    SendKeys "{ENTER}", True
    End If
    Sleep (3000)
    Call .Document.parentWindow.execScript("XMLSemCert()", "JavaScript")
    Sleep (3000)
    sJanela = FindWindow(vbNullString, nJanela)
    If sJanela <> 0 Then
    SendKeys "%S", True
    End If
    Sleep (3000)
    End With
    objIE.Quit
    Set objIE = Nothing
    On Error GoTo 0
    Exit Function
    AbrirSite_Error:
    msg = "Ocorreu um erro na aplicação." & vbCr
    msg = msg & "Relate os dados abaixo ao suporte." & vbCr
    msg = msg & "Erro nº: " & Err.Number & vbCr
    msg = msg & "Descrição do erro: " & Err.Description & vbCr
    msg = msg & "Módulo: mod_NFe " & vbCr
    msg = msg & "Procedimento: AbrirSite " & vbCr
    msg = msg & "Linha: " & Erl & "."
    MsgBox msg, vbCritical, "ATENÇÃO !!"
    End Function

    'Baixa notas existentes na tabela
    Function BaixaNFe()
    On Error GoTo BaixaNFe_Error
    Dim msg As String
    Dim db As DAO.Database, rst As DAO.Recordset, sSQL As String, icontar As Integer
    Set db = CurrentDb()
    sSQL = "SELECT tab_nfes.Id, tab_nfes.cnpj, tab_nfes.chave_nfe, tab_nfes.baixou"
    sSQL = sSQL & " FROM tab_nfes"
    sSQL = sSQL & " ORDER BY tab_nfes.cnpj, tab_nfes.chave_nfe;"
    Set rst = db.OpenRecordset(sSQL)
    If Not rst.EOF Then
    icontar = 1
    rst.MoveFirst
    Do Until rst.EOF
    If Not IsNull(rst("chave_nfe")) Then
    Call AbrirSite(rst("chave_nfe"))
    rst.Edit
    rst("baixou") = True
    rst.Update
    'Debug.Print icontar
    icontar = icontar + 1
    End If
    rst.MoveNext
    Loop
    End If
    rst.Close
    db.Close
    Set rst = Nothing
    Set db = Nothing
    On Error GoTo 0
    Exit Function
    BaixaNFe_Error:
    msg = "Ocorreu um erro na aplicação." & vbCr
    msg = msg & "Relate os dados abaixo ao suporte." & vbCr
    msg = msg & "Erro nº: " & Err.Number & vbCr
    msg = msg & "Descrição do erro: " & Err.Description & vbCr
    msg = msg & "Módulo: mod_NFe " & vbCr
    msg = msg & "Procedimento: BaixaNFe " & vbCr
    msg = msg & "Linha: " & Erl & "."
    MsgBox msg, vbCritical, "ATENÇÃO !!"
    End Function
    avatar
    FabioPaes
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3490
    Registrado : 14/08/2013

    Re: Rotina para baixar NFe...

    Mensagem  FabioPaes em Ter 31 Jan 2017, 17:25

    Amigo, se puder postar o exemplo dessa função, achei interessante...


    .................................................................................
    _____________________________________________________________________
    Achou a solução para sua dúvida? Não seja Egoísta, Compartilhe com todos!
    A dica do Colega foi útil? Agradeça!

    O importante não saber tudo, mas sim a Onde procurar!

    johnaccess
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 6
    Registrado : 01/11/2010

    Exemplo...

    Mensagem  johnaccess em Qua 01 Fev 2017, 00:30

    Segue arquivo... lembrem de enviar as melhorias... este arquivo contem também rotina para baixar dados via cnpj.
    Anexos
    Cnpj_Receita_Sintegra e NFe.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (77 Kb) Baixado 27 vez(es)

      Data/hora atual: Sab 16 Dez 2017, 09:16