Rotina para baixar NFe...

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

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

Segue arquivo... lembrem de enviar as melhorias... este arquivo contem também rotina para baixar dados via cnpj.