Excel Excel - Importar dados do corpo do e-mail para planilha do Excel

[Cfernandes]

Olá,

 

Gostaria de planilhar os dados de alguns e-mails salvos em um pasta, não consegui anexar o arquivo devido a extensão (Item do Outlook), mas o que preciso é colocar o número da NFS-e. razão social, e-mail e CNPJ (destacado em vermelho), conforme arquivo em anexo. 

 

Assunto:

[External] Nota Fiscal de Serviços Eletrônica - NFS-e No. 112356

 

E-mail:

Esta mensagem refere-se à Nota Fiscal de Serviços Eletrônica - NFS-e No. 112356 do prestador de serviços:

 

Razão Social: 

E-mail:    

CCM : 

CNPJ: 

 

A "frase de segurança" escolhida por você para garantir a autenticidade desta mensagem foi:

NFS-E TOMADOR - CFH NH

 

Atenção! Se a frase acima não for a que escolheu, apague imediatamente esta mensagem, pois pode conter vírus de computador.

 

Se a frase estiver correta, visualize a nota fiscal no endereço:

https://nfe.prefeitura.sp.gov.br/nfe.aspx?ccm=4120785&nf=102584=9DW82859

 

Alternativamente, acesse o portal https://nfe.prefeitura.sp.gov.br/publico/verificacao.aspx e verifique a autenticidade da nota fiscal informando:

CNPJ do prestador do serviço = 01.235.886/0001-23

Número da NFS-e =  112356

Código de verificação = iud-JAI9

 

 

Prefeitura de São Paulo

https://nfe.prefeitura.sp.gov.br/

 

 

* Este e-mail foi enviado automaticamente pelo Sistema da Nota do Milhão (NFS-e). Favor não responder. Em caso de dúvidas, entre em contato com [email protected]

Planilha_Exemplo.xlsx

[Muca Costa]

Tente adaptar o anexo às suas necessidades...

Planilha_Exemplo.rar

[Cfernandes]

@Muca Costa obrigada pelo retorno! Apenas algumas coisas não consegui adptar, anexei duas imagens: uma de como ficam os itens que preciso planilhar no e-mail dentro da pasta (Pasta de salvamento - E-mails) e a outra imagem "Exemplo do arquivo" é o arquivo aberto (pelo Outlook).

[Muca Costa]

Se possível, envie, para análise, os arquivos outlook.

[Muca Costa]

Abra o Outlook
Alt + F11
Inserir
Módulo

Insira a macro abaixo

Modo de usar: abra um e-mail(dois click's) do Outlook e em seguida execute a macro no Outlook

 

Dim mmli As MailItem

Sub fncExport2Excel()
    Dim inp As Inspector
    Dim appExcel As Object
    Dim wks As Object
    Dim xExcelFile As String
    Dim xNextEmptyRow As String
    
    Set mmli = Nothing
    
    On Error Resume Next
    
    xExcelFile = "D:\Downloads\EmailsOutlook.xlsx" 'Mude para a pasta onde consta a planilha Excel(em anexo)

    Set mmli = ActiveInspector.CurrentItem
    If mmli Is Nothing Then
        MsgBox "Abra o e-mail que deseja extrair os dados.", vbCritical
        GoTo Fim
    End If
    Set appExcel = GetObject(, "Excel.Application")
    On Error GoTo 0
    If appExcel Is Nothing Then
        Set appExcel = CreateObject("Excel.Application")
    End If
    appExcel.Visible = True
    
    Set wks = appExcel.Workbooks.Open(xExcelFile)
    Set wks = wks.Sheets(1)
    
    xNextEmptyRow = wks.Range("E1")
    
    wks.Range("A" & xNextEmptyRow) = fncGetInfo("NFS-e No. ")
    wks.Range("B" & xNextEmptyRow) = fncGetInfo("Razão Social: ")
    wks.Range("C" & xNextEmptyRow) = fncGetInfo("E-mail: ")
    wks.Range("D" & xNextEmptyRow) = fncGetInfo("CNPJ: ")
Fim:
End Sub

Function fncGetInfo(str As String) As String
    Dim lngStart As Long
    Dim lngEnd As Long
    Dim strBody As String
    
    strBody = mmli.Body
    
    lngStart = InStr(strBody, str)
    lngEnd = InStr(lngStart + 1, strBody, vbNewLine)
    fncGetInfo = Mid(strBody, lngStart, lngEnd - lngStart + 1)
End Function

 

EmailsOutlook.xlsx

[Cfernandes]

@Muca Costa eu teria uma opção de que isso seja feita com todos os e-mails de uma pasta especifica do Outlook, exemplo: Dentro da minha Caixa de entrada do Outlook, tenho uma pasta como "Notas Fiscais" e gostaria que todos os e-mails dentro dessa pasta fossem planilhados, pois são cerca de 180 e-mails desses por dia, então queria evitar de abrir um por um.

 

[Muca Costa]

Mais uma tentativa:

Abra o Outlook
Alt + F11
Inserir
Módulo
Insira a macro abaixo

Crie uma pasta para EXTRAIR os email"s, por exemplo Email

Execute a macro no Outlook

A macro cria txt com nome EmailRemetente+DataEmissão e exclui(para lixeira) os email's

Finalize o processo clicando no botão "Extrair" da planilha anexada...

Ao final os arquivos txt serão excluídos do diretório Email

 

Sub fncMensagens()
    'Execute esta macro no Outlook, Altere o caminho abaixo
    Const cstrOutput As String = "D:\Downloads\Email\Relatório.txt" ' só mude o diretório, não mude o nome Relatório.txt
    Dim intFF As Integer
    Dim mli As MailItem
    Dim rcp As Recipient
    Dim ctt As ContactItem
    Dim nms As NameSpace
    Dim objAllItems As Outlook.Items
    Dim objFilteredItems As Outlook.Items
    Dim objItem As Object
    Dim strCriteria As String
    Dim strDepartament As String
    Dim strOfficeLocation As String
    Dim Dir As String
    
    Dir = "D:\Downloads\Email\" 'Altere o caminho
 
    Set nms = Application.GetNamespace("MAPI")
    'Altere as pastas abaixo para como está configurado seu e-mail:
    Set objAllItems = nms.Folders("[email protected]").Folders("Notas Fiscais").Items
    
    intFF = FreeFile
    For Each objItem In objAllItems
    Open "D:\Downloads\Relatório.txt" For Output As #intFF
        If TypeName(objItem) = "MailItem" Then
        Set mli = objItem
            Print #intFF, "Título: " & mli.Subject
            Print #intFF, "Remetente: " & mli.SenderEmailAddress
            Print #intFF, "Data Envio: " & mli.SentOn
            Print #intFF, "MENSAGEM: "
            Print #intFF, mli.Body
            Print #intFF, ""
            Close #intFF
            NomeAntigo = "D:\Downloads\Email\Relatório.txt"
            NovoNome = Dir & mli.SenderEmailAddress & "-" & Format(mli.SentOn, "d.m.yyyy hh.mm.ss ") & ".txt"
            Name NomeAntigo As NovoNome
            objItem.Delete
        End If
    Next objItem
    Close #intFF
End Sub

 

OutlookTxtParaExcel.rar