Jump to content
Fórum Script Brasil
  • 0

Objeto Não aceita essa propriedade ou método


Question

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

Link to post
Share on other sites

3 answers to this question

Recommended Posts

  • 0

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.

 

Link to post
Share on other sites
  • 0

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

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Cloud Computing


  • Forum Statistics

    • Total Topics
      148680
    • Total Posts
      644502
×
×
  • Create New...