MaximoAccess

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

Obrigado

Administração do MaximoAccess


Participe do fórum, é rápido e fácil

MaximoAccess

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

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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

    Rotina para baixar NFe...

    avatar
    johnaccess
    Novato
    Novato

    Respeito às Regras 100%

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

    Rotina para baixar NFe... Empty Rotina para baixar NFe...

    Mensagem  johnaccess 31/1/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
    FabioPaes
    FabioPaes
    Maximo VIP
    Maximo VIP

    Respeito às Regras 100%

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

    Rotina para baixar NFe... Empty Re: Rotina para baixar NFe...

    Mensagem  FabioPaes 31/1/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!
    avatar
    johnaccess
    Novato
    Novato

    Respeito às Regras 100%

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

    Rotina para baixar NFe... Empty Exemplo...

    Mensagem  johnaccess 1/2/2017, 00:30

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

      Data/hora atual: 4/3/2021, 12:43