Objeto Não aceita essa propriedade ou método

[luiza lopes]

Tenho esse código que extrai o conteúdo do corpo do email e coloca em uma planilha no excel. Até ontem ele estava funcionando, porém hoje ele apareceu que " Objeto não aceita essa propriedade ou método" na linha que está em vermelho. Se alguém por favor poderia me ajudar?

 

 

<>Sub lerEmail()
    
    'Ler o e-mail e copiar para o excel as informações na aba "BD"

    Application.DisplayAlerts = False 'Desabilitar alertas
    Application.ScreenUpdating = False 'Desabilitar atualização de tela
    
    ActiveWorkbook.Save 'Salvar planilha
    
    Dim outApp As Outlook.Application 'Variável da aplicação do outlook
    Dim outMapi As Outlook.MAPIFolder 'Variável de conexão com as pastas desejadas, acesso ao e-mail
    'Dim outMail As Outlook.MailItem 'Variável do objeto e-mail
    Dim outHTML As MSHTML.HTMLDocument 'Variável HTML document
    
    Dim sh_capa, sh_bd As Worksheet 'Variáveis das abas do excel
    
    Set sh_capa = Sheets("Capa") 'Configura aba Capa
    Set sh_bd = Sheets("BD") 'Configura aba BD
    
    Dim pasta, subpasta, mover As String 'Variável pasta e subpasta outlook
    Dim num_email, num_db, i, j, k, l, m, num As Long 'Variáveis auxiliares
    Dim data As Date 'Variável da data de recebimento do e-mail
    
    pasta = sh_capa.Cells(6, "B").Value 'Configura pasta outlook
    subpasta = sh_capa.Cells(6, "C").Value 'Configura subpasta outlook
    mover = sh_capa.Cells(6, "D").Value 'Pasta destino
    
    On Error Resume Next 'Habilita tratamento de erros
        Set outApp = GetObject(, "OUTLOOK.APPLICATION") 'Tenta configurar a aplicação do outlook
        If (outApp Is Nothing) Then 'Se outlook não estiver aberto...
            Set outApp = CreateObject("OUTLOOK.APPLICATION") 'Configura a aplicação do outlook
        End If
    On Error GoTo 0 'Desabilita tratamento de erros
    
    Set outMapi = outApp.GetNamespace("MAPI").Folders(pasta).Folders(subpasta) 'Configura a variável de conexão com as pastas desejadas do outlook
    Set outHTML = New MSHTML.HTMLDocument 'Configura a variável HTML document para ler o corpo do e-mail
    
    'Verifica se existem e-mails disponíveis na subpasta desejada
    If outMapi.Items.Count = 0 Then
        MsgBox "Não foram encontrados e-mails"
        Exit Sub 'Interrompe o programa caso não encontre e-mails na subpasta
    End If
    
    num_email = outMapi.Items.Count 'Quantidade de e-mails na subpasta
    
    'Conta quantas linhas existem na aba "BD" para que os novos dados possam ser inseridos de forma sequencial
    num_db = sh_bd.Cells(Rows.Count, "A").End(xlUp).Row - 1
    
    num = 0 ' Variável responsável por contar quantos e-mails serão salvos
    For i = 1 To num_email
        
        Set outMail = outMapi.Items(i - num) 'Configura a variável do e-mail atual e subtrai quantos e-mails já foram copiados,
                                             'pois os e-mails são deletados da caixa de entrada
        
        'Data de recebimento do e-mail
        data = DateSerial(Year(outMail.ReceivedTime), Month(outMail.ReceivedTime), Day(outMail.ReceivedTime))
        
        'Se satisfazer todas as condições definidas na capa, incluse a busca por remetente...
         
         If outMail.Subject Like "*" & sh_capa.Cells(9, "C").Value And _
        outMail.SenderEmailAddress = sh_capa.Cells(10, "C").Value And _
        data >= sh_capa.Cells(11, "C").Value And _
        data <= sh_capa.Cells(12, "C").Value Then
            
     
            'Recebe o codigo HTML correspondente ao corpo do e-mail
            outHTML.Body.innerHTML = outMail.HTMLBody
            'Configura a variável para leitura da tabela recebida
            Set outTable = outHTML.getElementsByTagName("table")
            'Copia os campos da tabela para o excel
            For x = 1 To outTable(0).Rows.Length - 1
                For y = 0 To outTable(0).Rows(x).Cells.Length - 1
                    sh_bd.Cells(1 + num_db + x, 1 + y).Value = outTable(0).Rows(x).Cells(y).innerText
                Next y
            Next x
            'Variável auxiliar para copiar os dados de forma sequencial
            num_db = num_db + outTable(0).Rows.Length - 1
            
            'Conta quantos e-mails já foram salvos
            num = num + 1
            
            'Move o e-mail para a pasta de concluídos
            outMail.Move outApp.GetNamespace("MAPI").Folders(pasta).Folders(mover)
            
        'Se satisfazer todas as condições definidas na capa, exceto a busca por remetente...
        ElseIf outMail.Subject Like "*" & sh_capa.Cells(9, "C").Value And _
        sh_capa.Cells(10, "C").Value = "" And _
        data >= sh_capa.Cells(11, "C").Value And _
        data <= sh_capa.Cells(12, "C").Value Then
            
            'Recebe o codigo HTML correspondente ao corpo do e-mail
            outHTML.Body.innerHTML = outMail.HTMLBody
            'Configura a variável para leitura da tabela recebida
            Set outTable = outHTML.getElementsByTagName("table")
            'Copia os campos da tabela para o excel
            For x = 1 To outTable(0).Rows.Length - 1
                For y = 0 To outTable(0).Rows(x).Cells.Length - 1
                    sh_bd.Cells(1 + num_db + x, 1 + y).Value = outTable(0).Rows(x).Cells(y).innerText
                Next y
            Next x
            'Variável auxiliar para copiar os dados de forma sequencial
            num_db = num_db + outTable(0).Rows.Length - 1
            
            'Conta quantos e-mails já foram salvos
            num = num + 1
            
            'Move o e-mail para a pasta de concluídos
            outMail.Move outApp.GetNamespace("MAPI").Folders(pasta).Folders(mover)
        
        End If
        
    Next i
    
    'Se algum e-mail foi salvo...
    If num > 0 Then
        'Mensagem apresentada para o usuário
        MsgBox "Processamento Concluído! " & num & " e-mail carregados!"
        sh_bd.Select
    Else
        'Mensagem apresentada para o usuário
        MsgBox "Nenhum e-mail carregado!"
    End If
    
    'Volta a exibir alertas
    Application.DisplayAlerts = True
    'Volta a atualizar a tela
    Application.ScreenUpdating = True
    
End Sub

[Alyson Ronnan Martins]

Bom dia. 

precisa verificar o valor que esta retornando para "outMail.ReceivedTime"

Abra o VBA selecione a linha que esta causando o aperte o botão F9 para pausar o código nessa linha. (ela vai ficar em vermelho)
Agora execute o código e quando ele pausar (mostrando em amarelo a linha), posicione o mouse em cima da campo para que mostre o valor debaixo do mouse.

O valor que estar retornando não deve estar no formato de data para o parametro YEAR, MONTH e DAY conseguirem entender a informação.

Quando tiver a informação tira um print e mostrar aqui no forum que posso tentar te ajudar.

 

[luiza lopes]

Então o código retorna uma data diferente do dia atual, e creio que isso esteja vinculado a esta linha aqui "Dim outMail As Outlook.MailItem 'Variável do objeto e-mail" desabilitada por problemas de variável. Porém não sei como arrumar. Segue o código e o problema da linha:

<>Sub lerEmail()
    
    'Ler o e-mail e copiar para o excel as informações na aba "BD"

    Application.DisplayAlerts = False 'Desabilitar alertas
    Application.ScreenUpdating = False 'Desabilitar atualização de tela
    
    ActiveWorkbook.Save 'Salvar planilha
    
    Dim outApp As Outlook.Application 'Variável da aplicação do outlook
    Dim outMapi As Outlook.MAPIFolder 'Variável de conexão com as pastas desejadas, acesso ao e-mail
    'Dim outMail As Outlook.MailItem 'Variável do objeto e-mail
    Dim outHTML As MSHTML.HTMLDocument 'Variável HTML document
    
    Dim sh_capa, sh_bd As Worksheet 'Variáveis das abas do excel
    
    Set sh_capa = Sheets("Capa") 'Configura aba Capa
    Set sh_bd = Sheets("BD") 'Configura aba BD
    
    Dim pasta, subpasta, mover As String 'Variável pasta e subpasta outlook
    Dim num_email, num_db, i, j, k, l, m, num As Long 'Variáveis auxiliares
    Dim data As Date 'Variável da data de recebimento do e-mail
    
    pasta = sh_capa.Cells(6, "B").Value 'Configura pasta outlook
    subpasta = sh_capa.Cells(6, "C").Value 'Configura subpasta outlook
    mover = sh_capa.Cells(6, "D").Value 'Pasta destino
    
    On Error Resume Next 'Habilita tratamento de erros
        Set outApp = GetObject(, "OUTLOOK.APPLICATION") 'Tenta configurar a aplicação do outlook
        If (outApp Is Nothing) Then 'Se outlook não estiver aberto...
            Set outApp = CreateObject("OUTLOOK.APPLICATION") 'Configura a aplicação do outlook
        End If
    On Error GoTo 0 'Desabilita tratamento de erros
    
    Set outMapi = outApp.GetNamespace("MAPI").Folders(pasta).Folders(subpasta) 'Configura a variável de conexão com as pastas desejadas do outlook
    Set outHTML = New MSHTML.HTMLDocument 'Configura a variável HTML document para ler o corpo do e-mail
    
    'Verifica se existem e-mails disponíveis na subpasta desejada
    If outMapi.Items.Count = 0 Then
        MsgBox "Não foram encontrados e-mails"
        Exit Sub 'Interrompe o programa caso não encontre e-mails na subpasta
    End If
    
    num_email = outMapi.Items.Count 'Quantidade de e-mails na subpasta
    
    'Conta quantas linhas existem na aba "BD" para que os novos dados possam ser inseridos de forma sequencial
    num_db = sh_bd.Cells(Rows.Count, "A").End(xlUp).Row - 1
    
    num = 0 ' Variável responsável por contar quantos e-mails serão salvos
    For i = 1 To num_email
        
        Set outMail = outMapi.Items(i - num) 'Configura a variável do e-mail atual e subtrai quantos e-mails já foram copiados,
                                             'pois os e-mails são deletados da caixa de entrada
        
        'Data de recebimento do e-mail
        data = DateSerial(Year(outMail.ReceivedTime), Month(outMail.ReceivedTime), Day(outMail.ReceivedTime))
        
        'Se satisfazer todas as condições definidas na capa, incluse a busca por remetente...
         
         If outMail.Subject Like "*" & sh_capa.Cells(9, "C").Value And _
        outMail.SenderEmailAddress = sh_capa.Cells(10, "C").Value And _
        data >= sh_capa.Cells(11, "C").Value And _
        data <= sh_capa.Cells(12, "C").Value Then
            
     
            'Recebe o codigo HTML correspondente ao corpo do e-mail
            outHTML.Body.innerHTML = outMail.HTMLBody
            'Configura a variável para leitura da tabela recebida
            Set outTable = outHTML.getElementsByTagName("table")
            'Copia os campos da tabela para o excel
            For x = 1 To outTable(0).Rows.Length - 1
                For y = 0 To outTable(0).Rows(x).Cells.Length - 1
                    sh_bd.Cells(1 + num_db + x, 1 + y).Value = outTable(0).Rows(x).Cells(y).innerText
                Next y
            Next x
            'Variável auxiliar para copiar os dados de forma sequencial
            num_db = num_db + outTable(0).Rows.Length - 1
            
            'Conta quantos e-mails já foram salvos
            num = num + 1
            
            'Move o e-mail para a pasta de concluídos
            outMail.Move outApp.GetNamespace("MAPI").Folders(pasta).Folders(mover)
            
        'Se satisfazer todas as condições definidas na capa, exceto a busca por remetente...
        ElseIf outMail.Subject Like "*" & sh_capa.Cells(9, "C").Value And _
        sh_capa.Cells(10, "C").Value = "" And _
        data >= sh_capa.Cells(11, "C").Value And _
        data <= sh_capa.Cells(12, "C").Value Then
            
            'Recebe o codigo HTML correspondente ao corpo do e-mail
            outHTML.Body.innerHTML = outMail.HTMLBody
            'Configura a variável para leitura da tabela recebida
            Set outTable = outHTML.getElementsByTagName("table")
            'Copia os campos da tabela para o excel
            For x = 1 To outTable(0).Rows.Length - 1
                For y = 0 To outTable(0).Rows(x).Cells.Length - 1
                    sh_bd.Cells(1 + num_db + x, 1 + y).Value = outTable(0).Rows(x).Cells(y).innerText
                Next y
            Next x
            'Variável auxiliar para copiar os dados de forma sequencial
            num_db = num_db + outTable(0).Rows.Length - 1
            
            'Conta quantos e-mails já foram salvos
            num = num + 1
            
            'Move o e-mail para a pasta de concluídos
            outMail.Move outApp.GetNamespace("MAPI").Folders(pasta).Folders(mover)
        
        End If
        
    Next i
    
    'Se algum e-mail foi salvo...
    If num > 0 Then
        'Mensagem apresentada para o usuário
        MsgBox "Processamento Concluído! " & num & " e-mail carregados!"
        sh_bd.Select
    Else
        'Mensagem apresentada para o usuário
        MsgBox "Nenhum e-mail carregado!"
    End If
    
    'Volta a exibir alertas
    Application.DisplayAlerts = True
    'Volta a atualizar a tela
    Application.ScreenUpdating = True
    
End Sub

[Alyson Ronnan Martins]

poderia me mandar a foto do erro para olhar?