Planilha de importar NFEs - Excel VBA

Objetivo: Disponibilizar planilha Excel exemplo para importar notas fiscais eletrônicas a partir dos arquivos XML.

A planilha funciona de uma forma muito simples, você seleciona a pasta aonde estão os arquivos XML disponibilizados pelos fornecedores ou os seus, clicando no botão ao lado da lista do "Local para leitura das NFEs:".

Nota: Este botão funciona no Excel 2010, para o Excel 2007, identifique no código fonte a palavra PtrSafe e apague ela, esta palavra faz com que a função funcione também em Windows 64 bits, que é o caso do Windows 7.

Após ter selecionado a pasta, basta clicar no botão Importar, os arquivos serão automaticamente colocados na planilha "Lista de notas fiscais" do arquivo.

O mesmo trabalho também poderia ser feito abrindo arquivo a arquivo XML e depois colando um embaixo do outro dentro de uma planilha, este trabalho é realizado pelo código Excel VBA que segue abaixo:

'Colocar esta parte do código no início do módulo
Public Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias _
    "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) _
    As Long
Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Dim fPasta As String

Sub lsImportarNotas()
    Workbooks.OpenXML Filename:= _
        "C:\Rieper\Blog\Ler nfes\35121013585367000166550010000006191045355778-nfe.xml" _
        , LoadOption:=xlXmlLoadImportToList
End Sub

Sub ListarArquivosExcel()
    Dim FName               As String

    'Cria um vetor de strings
    Dim arNames()           As String

    Dim myCount             As Integer
    Dim lsExtensao          As String
    Dim lUltimaLinhaAtiva   As Long
    Dim lNomePlanilha       As String

    Application.DisplayAlerts = False

    'Camihho do arquivo
    lsExtensao = "*.xml"

    'Determina o diretório e a extensão do arquivo
    FName = Dir(fPasta & lsExtensao)

    'Limpa a planilha
    Sheets("Lista de notas fiscais").Range("A:XFD").Clear

    'Enquanto FName for igual a vazio "", realiza a listagem dos arquivos
    Do Until FName = ""
        myCount = myCount + 1
        'Redimensiona o vetor, preservando os dados
        ReDim Preserve arNames(1 To myCount)
        arNames(myCount) = FName
        'Passa os dados para a planilha
        Worksheets("Lista de notas fiscais").Select
        Workbooks.OpenXML Filename:= _
            Worksheets("Configuração").Range("c6").Value & "\" & arNames(myCount) _
            , LoadOption:=xlXmlLoadImportToList

        lNomePlanilha = ActiveWorkbook.Name

        'Copiar e fechar a planilha ativa
        If myCount = 1 Then
            Rows("1:20000").Select
        Else
            Rows("2:20000").Select
        End If
        Selection.Copy
        Windows("Planilha de apresentação de NFes.xlsm").Activate

        lUltimaLinhaAtiva = Worksheets("Lista de notas fiscais").Cells(Worksheets("Lista de notas fiscais").Rows.Count, 1).End(xlUp).Row

        Range("A" & lUltimaLinhaAtiva).Select

        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False

        'Atualiza a variável FName
        FName = Dir

        Windows(lNomePlanilha).Close
    Loop

    Cells.Select
    Cells.EntireColumn.AutoFit

    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$DJ$100000"), , xlYes).Name = _
        "Tabela1"
    Range("Tabela1[#All]").Select
    ActiveSheet.ListObjects("Tabela1").TableStyle = "TableStyleMedium9"
    Range("Tabela1[[#Headers],[versao]]").Select
    Sheets("Configuração").Select
    Range("C7").Select

    Application.DisplayAlerts = True
End Sub

Public Function gfSelecionarPasta(ByVal vFolder As String, Optional Title As String, Optional hWnd) As String

    Dim bi As BROWSEINFO
    Dim pidl As Long
    Dim folder As String

    folder = String$(255, Chr$(0))

    With bi
        If IsNumeric(hWnd) Then .hOwner = hWnd
        .pidlRoot = 0
        If Title <> "" Then
            .lpszTitle = Title & Chr$(0)
        Else
            .lpszTitle = "Select a Folder" & Chr$(0)
        End If
    End With

    pidl = SHBrowseForFolder(bi)

    If SHGetPathFromIDList(ByVal pidl, ByVal folder) Then
        folder = Left(folder, InStr(folder, Chr$(0)) - 1)
    Else
        folder = ""
    End If

    If Right(folder, 1) <> "\" And Len(folder) > 0 Then folder = folder & "\"

    gfSelecionarPasta = folder

End Function

Public Sub gfPasta()
    fPasta = gfSelecionarPasta("C:", "Selecione a pasta dos arquivos das NFes:")
    Range("C6").Value = fPasta
End Sub

Esta solução é gratuita, basta clicar no botão de download abaixo, mas temos também uma planilha de importação automática em Excel da NFe na versão 3.1, veja em nossa loja.