none
Código VBA para Salvar Anexos de Novas Mensagens do Outlook numa Pasta do computador RRS feed

  • Pergunta

  • Boa noite caros amigos,

    Gostaria de saber se alguém poderia me ajudar a desenvolver ou se já existe um Código VBA para Salvar Anexos de Novas Mensagens do Outlook numa Pasta do computador.

    Tenho uma atividade bastante rotineira que me obriga a gerar relatórios do sistema, que por sua vez chegam no email com anexos em txt, + - uns 40 emails com um anexo cada, daí preciso baixar cada um deles para meu computador para tratar.

    Se possível gostaria que no código constasse algo também para manipulação do nome do arquivo, ou seja, o arquivo vem com um nome muito grande no email, por exemplo: o anexo vem no email assim "Atr7700-tmp003220110502156270.txt", gostaria de excluir os seis últimos dígitos do nome do arquivo, o exemplo ficaria assim "Atr7700-tmp003220110502.txt".

    Desde já agradeço a cooperação e atenção de todos.

    quinta-feira, 5 de maio de 2011 02:17

Respostas

  • Olá Regi boa tarde,

    Para executar este procedimento crie um módulo, neste módulo insira o seguinte algoritmo:

    Sub GetAttachments()
    On Error GoTo GetAttachments_err
    ' Declaração de variáveis
    Dim ns As Namespace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
    'Verifica no seu inbox se existe algum anexo de acordo com o assunto especificado
    If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
    "Nothing Found"
    Exit Sub
    End If
    ' Check each message for attachments
    For Each Item In Inbox.Items
    'Este nome entre aspas duplas é o assunto do email que contém o anexo, MUDE DE ACORDO COM SEU EMAIL
    If Item = "Email com anexo" Then
    ' Save any attachments found
    For Each Atmt In Item.Attachments
    ' Em filename você irá inserir o caminho de onde quer salvar seu anexo, MUDE DE ACORDO COM SEU AMBIENTE.
    FileName = "C:\Users\carlos\Desktop\anexos\" & Atmt.FileName
    Atmt.SaveAsFile FileName
    i = i + 1
    Next Atmt
    End If
    Next Item
    ' Show summary message
    If i > 0 Then
    MsgBox "I found " & i & " attached files." _
    & vbCrLf & "I have saved them into the C:\Users\carlos\Desktop\anexos." _
    & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
    Else
    MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
    ' Clear memory
    GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
    ' Handle errors
    GetAttachments_err:
    'MsgBox "An unexpected error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
    Resume GetAttachments_exit
    End Sub

    Depois adicione um commandbutton em seu formulário e adicione o seguinte algoritmo:

    Private Sub cmdBuscaAnexos_Click()
    GetAttachments
    End Sub

    Só fico te devendo a parte da alteração do nome do arquivo.

    Espero ter te ajudado com seu problema principal de salvar os anexos, se sim por favor qualificar como resposta.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    quinta-feira, 5 de maio de 2011 16:42
  • Alguns comentários.

    Você misturou parte dos dois códigos. Use a declaração de variável obrigatória para evitar erros: http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/

    No código do Carlos, observe que o Objeto de mensagem analisado é Item, declarado como Object. No meu exemplo, Item é declarado como MailItem.

    Pelo que eu pude ver, se usar o código:

    Public Sub SalvarAnexo(Item As MailItem)
      
      Dim Atmt As Attachment
      Dim FileName As String
      
      'Mude o caminho da pasta destino que os anexos serão salvos aqui.
      'Não se esqueça de colocar a última barra invertida
      Const sPasta As String = "c:\temp\"
      
      'Especifique abaixo a regra sobre o assunto do e-mail para que ele queria salvar anexos:
      If Item.Subject Like "*Email com anexo*" Then
        For Each Atmt In Item.Attachments
          'Especifique abaixo a regra sobre o nome do anexo para que o mesmo possa ser salvo:
          If Atmt.FileName Like "*Email com anexo*" Then
            FileName = sPasta & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
            Atmt.SaveAsFile FileName
          End If
        Next Atmt
      End If
      
    End Sub

    Por último, não se esqueça de criar uma regra para executar esse script quando receber uma mensagem! Isso é explicado com detalhes aqui: http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/

     


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:29
    quarta-feira, 25 de maio de 2011 19:18
    Moderador
  • Amigos bom dia,

    Na verdade o código já tem uma regra, a regra esta sendo definida pelo assunto do email, ou seja, o código verifica se o assunto confere, se sim, é feito o download do anexo, no meu exemplo a regra é: se o assunto do email for "email com anexo" será feito download do anexo do respectivo email.

    Teste desta forma que você verá que o download do anexo será feito com sucesso.

    Espero ter ajudado, se sim por favor qualificar como resposta.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    • Sugerido como Resposta Carlos C Citrangulo Jr segunda-feira, 9 de maio de 2011 14:11
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    segunda-feira, 9 de maio de 2011 14:11
  • Kadu boa tarde,

    Não sei se você tem experiência nos fórums, mas mas quando sua dúvida é solucionada como você mesmo informou acima, você deve marcar a resposta como RESPOSTA, repare que no canto direito superior tem um V com uma interrogação em cima, para marcar como resposta você deve clicar neste ícone.

    Desta forma eu já passei 2 soluções, e ainda não foi marcada nenhuma como resposta, para que os fórums fiquem organizados, por favor MARCAR COMO RESPOSTAS as que serviram como solução, assim podemos continuar te ajudando.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    • Sugerido como Resposta Kadu001 sexta-feira, 20 de maio de 2011 02:09
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    quinta-feira, 19 de maio de 2011 20:04
  • Kadu, sem problemas, aproveito e tiro esta sua dúvida também.

    É importante que se fassamos bom uso do fórum assim mantemos o mesmo organizado e produtivo.

    Na verdade eu me expressei errado, você deve clicla somente no botao MARCAR COMO RESPOSTA, que é um V em verde, faz o seguinte da uma olhada nas respostas que te dei acima e veja se alguma tem um V em verde, as que tiverem e servirão como resposta, por favor marcar como Resposta. Caso não tenha nenhuma nesta condição é porque deve ter dado algum BUG, mas ainda sim você pode votar como útil, as que você achou útil, e a terceira opção é marcar como resposta e votar como útil ao mesmo tempo.

    OBS. Você deve estar logado.

    Depois da uma olhada com calma neste link: http://social.msdn.microsoft.com/Forums/pt-BR/help#310

    Este link citado acima explica todo o funcionamento do fórum, acho legal todos lerem esta FAQ.

    Espero ter ajudado, se sim, por favor MARCAR as RESPOSTAS que serviram.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    sexta-feira, 20 de maio de 2011 04:03
  • Carlos, fiz uma pesquisa para tentar encontrar um código que me ajudasse.

    O que idealizei como solução para esse problema, foi criar um código onde eu pudesse criar uma regra no outlook, que ao chegar um novo email que se encaixe nas regras pré-estabelecidas, ele executasse um script, que por sua vez estará atrelado a esse código. Ao executar o código o anexo seria salvo em uma pasta previamente informada. Como não tenho muito conhecimento em VBA, não sei se o que você desenvolveu funcionará da forma como expliquei, de uma forma ou de outra vou testar e caso tenha solucionado, darei o retorno.

    Mais uma vez agradeço a atenção desprendida.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:30
    sexta-feira, 6 de maio de 2011 00:37
  • Carlos estou precisando do mesmo código para salvar os anexos,fiz o procedimento porém na criação de regras o script não aparece,mesmo salvando o projeto.Como faço para aparecer o script na caixa de "seleção de script" na criação de regras do outlook?

     

    Agradeço desde Ja

    Kadu

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:30
    segunda-feira, 9 de maio de 2011 13:45
  • Ok.

    Muito obrigado Carlos.

     

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    segunda-feira, 9 de maio de 2011 15:01
  • Carlos, Criei o módulo e colei o código. Funcionou muito bem, porém, gostaria de se possível que o critério para que quando eu executasse a Macro, não fosse o assunto, e sim, se o email contiver um ou mais anexos, independente de sua extensão, o(s) anexo(s) fosse(m) salvo(s) no local especificado. Dessa forma eu criaria uma Regra para que a macro só fosse executada para os emails que obedecessem a mesma. Dessa forma seria melhor desabilitar as mensagens que são apresentadas quando o código é executado. Inclusive testei alguns códigos que encontrei usando uma Regra para executar um Script, e não funcionou, podes me orientar o porque? Outra forma que poderia ser utilizada é que quando chegasse um email eu criaria uma Regra para direciona-las automaticamente para uma pasta do Outlook, e na pasta eu executaria manualmente a macro. Para isso, na macro deveria constar o local para colocar o nome dessa pasta para que a macro não fosse executada na caixa de entrada. Podes nos ajudar Carlos, qualquer uma das formas serviria, de preferência a primeira opção. Grato pelo apoio e atenção. RegiCunha
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    quarta-feira, 11 de maio de 2011 03:16
  • Boa Tarde Carlos,

    Só mais uma coisa que notei agora...está funcionando perfeitamente..porém o anexo só é salvo com o campo "assunto" preenchido do jeito que está no código,ou seja,inteiro...tem há possibilidade de salvar a mensagem,contendo só uma parte do assunto ou palavra,exemplo: Assunto: "email com anexo código 123" ele reconhecer somente "email com anexo" e já salvar,fiz o teste e não conseguir..pode me ajudar,por favor?

     

    Agradeço desde ja

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    quinta-feira, 19 de maio de 2011 19:42
  • Olá Carlos,

    Infelizmente não sabia dessa marcação,peço desculpas..quanto ao ícone mencionado,ele não fica disponível como um link,por isso não da pra "clicar"..não seria em outro lugar?testei com a sua mensagem a cima em um link do lado de "citação"..e o icone da intergogação como vc mencionou,apareceu no canto superior direito..é isso?caso não..fico a disposição para marcação certa da resposta...

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 02:12
  • Carlos,

    Eu já havia notado o (sac) conforme mencionou,realmente não aparece nenhum link ou V em verde para marcar,deve esta ocorrendo algum BUG,de qualquer maneira como efetuado na 2 resposta,votei para conceder os seus créditos..td bem?quando voltar ao normal,eu marco a resposta como útil,conforme explicado,sem problemas :)

    Quanto a pergunta,é possível fazer dessa maneira?sem ter a frase toda do assunto?

     

    No Aguardo,

    Abraço

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 14:12
  • Kadu, o problema foi totalmente resolvido? O que mais falta?
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 15:44
    Moderador
  • Olá Benzadeus,

    O Carlos me ajudou bastante,só esta faltando uma coisa pra ficar perfeito:

    O script que ele me passou está funcionando corretamente,porém ele só funciona se o assunto estiver do jeito que está no código,gostaria de saber se tem a possibilidade de complementar o código da seguinte condição: a mensagem chega, se o assunto tiver pelo menos uma palavra ou frase que eu relatar no script,ele salva o anexo.ex:

    Assunto: "email com anexo"

    próximo e-mail..

    Assunto: "email com anexo dois"

    Independente do "dois" ele ler a frase "email com anexo" e salva o anexo na pasta.

    Pode me ajudar?

     

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 16:42
  • Pelo que percebi, o código fornecido não atua sobre novas mensagens recebidas. Se quiser que a macro trabalhe desta forma, dê uma olhada em http://www.ambienteoffice.com.br/outlook/salvar_anexos_de_novas_mensagens_numa_pasta/


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 18:58
    Moderador
  • Um detalhe importante: você deverá mudar o critério para que os anexos sejam salvos. Troque a linha

    If Right(Atmt.FileName, 4) = "xlsx" Then

    por, por exemplo:

    If Atmt.FileName Like = "Atr7700-tmp*.txt" Then


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 19:00
    Moderador
  • Bom dia Felipe,

    Obrigado pela ajuda,porém houve um erro de expressão no igual,ao modificar o código solicitado,poderia verificar novamente por gentileza.

     

    Abraço

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 12:06
  • Erro meu. Retire o símbolo de igual.
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 12:26
    Moderador
  • Felipe,

    Infelizmente o arquivo não foi salvo na pasta...o do carlos funcionou porém gostaria que salvasse ou quando remetente eviasse(tipo uma regra) ou no assunto contiver alguma palavra ou frase(não necessariamente o assunto inteiro).

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 13:30
  • As propriedades que você quer acessar do item de e-mail são:

    No exemplo que te passei, Item é o parâmetro de entrada da regra, ou seja, o objeto de Email.

    A propriedade Subject corresponde ao assunto, que você quer testar.

    Poderia ser algo como:

     

    If mi.Subject Like "Texto*" Then

     


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 13:51
    Moderador
  • É Felipe,

    Muito obrigado pelo esforço,mas fiz alteração no código e nada..

    deve ter alguma condição que esta faltando..

     

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 14:25
  • Poste aqui o código completo que você está usando.
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 14:36
    Moderador
  • Felipe,

    Segue o codigo.

    Obs lembrando que ja tentei com o seu tmb.

    Abraço

    Sub GetAttachments()
    On Error GoTo GetAttachments_err
    ' Declaração de variáveis
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
    'Verifica no seu inbox se existe algum anexo de acordo com o assunto especificado
    If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
    "Nothing Found"
    Exit Sub
    End If
    ' Check each message for attachments
    For Each Item In Inbox.Items
    'Este nome entre aspas duplas é o assunto do email que contém o anexo, MUDE DE ACORDO COM SEU EMAIL
    If mi.Subject Like "Email com anexo" Then
    ' Save any attachments found
    For Each Atmt In Item.Attachments
    ' Em filename você irá inserir o caminho de onde quer salvar seu anexo, MUDE DE ACORDO COM SEU AMBIENTE.
    FileName = "c:\anexos\" & Atmt.FileName
    Atmt.SaveAsFile FileName
    i = i + 1
    Next Atmt
    End If
    Next Item
    ' Show summary message
    If i > 0 Then
    MsgBox "I found " & i & " attached files." _
    & vbCrLf & "I have saved them into the c:\Documents and Settings\990885\Desktop\anexos" _
    & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
    Else
    MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
    ' Clear memory
    GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
    ' Handle errors
    GetAttachments_err:
    'MsgBox "An unexpected error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
    Resume GetAttachments_exit
    End Sub

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:29
    quarta-feira, 25 de maio de 2011 14:43
  • Ola Felipe,

    Desculpe pela demora,mas fiz o teste mencionado e infelizmente não funcionou.Ha uma possibilidade de fazer com que o anexo seja salvo na pasta pelo remetente e nao pelo assunto,acho que funcionaria melhor.

    Obrigado pela ajuda que está prestando.

     

    Abraço

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    quinta-feira, 2 de junho de 2011 15:14
  • Testei mais algumas vezes e está funcionando. Você leu o artigo que te passei para executar um script quando uma mensagem chega?

    Por remetente, o algo ficaria como algo abaixo:

    Public Sub SalvarAnexo(Item As MailItem)
      
      Dim Atmt As Attachment
      Dim FileName As String
      
      'Mude o caminho da pasta destino que os anexos serão salvos aqui.
      'Não se esqueça de colocar a última barra invertida
      Const sPasta As String = "c:\temp\"
      
      'Especifique abaixo o endereço de e-mail do remetente:
      If Item.SenderEmailAddress Like "benzadeus@ambienteoffice.com.br" Then
        For Each Atmt In Item.Attachments
          FileName = sPasta & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
          Atmt.SaveAsFile FileName
        Next Atmt
      End If
      
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:29
    quinta-feira, 2 de junho de 2011 15:18
    Moderador
  • Valeu Felipe,

    Mas ao depurar o código deu erro nessa linha "If Item.SenderEmailAddress = "email@teste.com.br" Then"

    erro : 438

    Obs: troquei o e-mail.

    Obrigado novamente,

     

    Kadu

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 7 de junho de 2011 11:40
  • Hum... estou achando que você mudou algo importante no código.

    Minha opinião é que você trocou o cabeçalho de:

    Public Sub SalvarAnexo(Item As MailItem)

    para:

    Public Sub SalvarAnexo()

    porque não estava conseguindo executar a macro. Estou certo?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 7 de junho de 2011 12:59
    Moderador
  • Pior que não...hehehe..

     

    Só copiei e colei...vc chegou a testar?

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 7 de junho de 2011 14:13
  • Cheguei a testar sim, está funcionando.

    Só para confirmar, você seguiu os passos de http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 7 de junho de 2011 15:00
    Moderador
  • Boa tarde,

    Pessoal, li os posts, mas tentei fazer e não deu certo. Alguém pode me ajudar?

    Desde já obrigado!

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 9 de agosto de 2011 19:51
  • Onde está tendo dificuldade?
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 9 de agosto de 2011 19:59
    Moderador
  • Kadu001, para só uma parte da frase do assusto, faça como segue:

    Por exemplo: Este é o assunto "email com anexo código 123"

    dim strAssunto as string, strParteDoAssusnto as string

    strAssunto="email com anexo código 123"

    strParteDoAssunto=Left(strAssunto,Len("email com anexo código "))

    Abraço.

    Raf.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    domingo, 21 de agosto de 2011 12:33
  • Kadu001,

    Na hora que seu programa chega no ponto abaixo, de verificar o assunto faça o seguinte:

    ‘Crie 2 variáveis string, uma para pegar o assunto inteiro = Item, e outra para transformá-la no pedaço que você quer. Veja:

    Dim strAssunto as string, strParteDoAssusnto as string

    For Each Item In Inbox.Items

     ‘vai para essa função abaixo, que arruma o assunto para a parte que você quer (a função está criada mais abaixo)

      strAssunto = Item

    strParteDoAssunto = fSetParteDoAssunto(   strAssunto )

    If Left(Item, 23) = strParteDoAssunto Then

     ' Save any attachments found

     For Each Atmt In Item.Attachments

     ' Em filename você irá inserir o caminho de onde quer salvar seu anexo, MUDE DE ACORDO COM SEU AMBIENTE.

     FileName = "C:\Pasta\" & Atmt.FileName

     Atmt.SaveAsFile FileName

     i = i + 1

     Next Atmt

     End If

     Next Item

    .

    .

    .

    abaixo segue a função que pega só o pedaço que você quer do assusnto

    Private Function fSetParteDoAssunto    (strPala2 As String) as String

      Dim strPala1 As String

      strPala1 = strPala2

      strParteDoAssusnto = Left(“email com anexo código “, Len( strPala1 ))

    End Function

    Dá certo, porque eu adequei o assunto na mesma rotina que você está usando e funciona. Por favor, fale-me se você conseguiu? Grata Raf. 21/08/2011.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    domingo, 21 de agosto de 2011 13:10
  • Pessoal, gostaria de uma ajuda. Criei este script copiando de um site indicado por vocês:

    Public Sub SalvarAnexo(Item As MailItem)
     
     Dim Atmt As Attachment
     Dim FileName As String
     
     For Each Atmt In Item.Attachments
      If Right(Atmt.FileName, 4) = "xlsx" Then
       FileName = "C:\temp\" & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
       Atmt.SaveAsFile FileName
      End If
     Next Atmt
     
    End Sub

    Bom, no meu caso eu alterei "xlsx" para "xml" e no campo "c:\temp\" alterei para "t:\" que é minha unidade de rede onde serão copiados os arquivos.

    Seguinte, crio a regra normalmente no outlook para quando chegar e-mail o script rodar e tudo mas não acontece nada.

    Testei em uma dúzia de Outlook aqui (2007) e acontece o mesmo: nada.

    Com não sou expert em Visual Basic, estou achando que deixei de fazer algum passo importante.

    Fiz o seguinte: abri o MVB no outlook a partir do alt+11, botão direito em cima de Projeto 1 e Inserir Módulo, alterei conforme informei acima, cliquei em Arquivo-Salvar VbaProject.otm, depois em Fechar e voltar para o Microsoft Outlook, Regras e Alertas, Nova regra, Verificar mensagem quando chegarem, regra aplicada a cada mensagem recebida, executar um script (Projeto1.SalvarAnexo), sem exceções, Concluir e OK.

    Agradeço imensamente quem puder desvendar este mistério.

    Há outra dúvida, quando as mensagens chegarem e o script rodar, automaticamente são copiadas ou é necessário intervenção do usuário, tipo abri a mensagem ou outra ação ?

    Muito obrigado.


    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    quarta-feira, 31 de agosto de 2011 16:29
  • Você conseguiu fazer funcionar o exemplo em http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/?
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    sexta-feira, 2 de setembro de 2011 01:32
    Moderador
  • Fala amigão, fiz este procedimento sim. Alias o codigo que copie na minha pergunta é exatamente deste site.


    Ja fiz de tudo mas não tem jeito, ele simplesmente não funciona.

    A mensagem chega e tudo mas não acontece nada, a regra ta certinha e tal mas nada de fucionar.

    Fogo isso viu, toda hora tenho que estar verificando e-mail par ver se chegou nota fiscal pra copiar na munheca e jogar na pasta.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 13:03
  • Você habilitou as macros do seu Outlook já?

     

    Em Arquivo >> Opções >> Central de Confiabilidade >> Configurações da Central de Confiabilidade >> Configurações de Macro >> Habilitar todas as macros.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 14:21
    Moderador
  • Fala brother.

    Acabei de fazer e nada :(

    Ate reinstalei o Outlook e nada...

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 20:29
  • Você sabe se a rotina está sendo executada quando chega uma mensagem?

     

    Aperte F9 na linha do procedimento que você quer que execute quando chega uma mensagem. Dessa forma, você criará um ponto de interrupção e depurará a rotina.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 20:39
    Moderador
  • Vê se estou certo: apertei f9 na linha:


    For Each Atmt In Item.Attachments

    Aí a linha ficou vermelha com um ponto ao lado, envivei um e-mail com anexo xml mas nada aconteceu...

    Caramba, pior que todo micro que testo é a mesma coisa não é possivel...

     


    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 21:00
  • Não estamos falando então do mesmo exemplo.

     

    O exemplo a que estou me referindo é o do link http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/, e nele não há essa linha de código.

    Tente fazê-lo funcionar, e acione o F9 na linha

    Sub MensagemRecebida(Item As MailItem)

    OK?

    Em seguida, envie um e-mail pra você mesmo.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 21:38
    Moderador
  • Cara obrigadão pela paciencia viu :)

    Teste este outro script e não acontece nada...

    E a regra esta certinho (executar script em toda as mensagens que chegarem)

    O estranho é que em todos os outlooks aqui da empresa estão assim :(

    Estou usando o office 2007 original e nada...

    Caraca to quase indo pra um terreiro :)

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 12:23
  • Isso não é bom, não entendo o que está acontecendo. Será que é algum pequeno detalhe que está passando batido, pelo fato do seu Outlook ser 2007 e o do exemplo ser o 2010?

    Em paralelo, vou revisar o texto, ver se está faltando alguma coisa. Se eu descobrir alguma coisa que está faltando, te falo.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 12:52
    Moderador
  • Hmm bem pensando,


    Vou instalar um 2010 aqui é fazer o teste, vai que da certo.


    Obrigadão mais uma vez pela ajuda.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 12:59
  • Fala amigão, cara obrigado pela ajuda.

    Instalei o 2010 e funcionou beleza :)

    Agora pra deixar o negócio ainda mais intrigante, se eu te falar que em um unico micro aqui que tem Outlook 2007 funcionou ?

    E detalhe: neste micro que funiconou, desligaram ele na hora do almoço e agoraa regra deste 2007 não funciona mais ?

    ehheheheheheheh vai entender

    Bom, mais o que interessa pra mim é que funcionou no micro que precisava funcionar.

    Valeu mais uma vez pela grande imensa ajuda.

    Abraço...

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 18:44
  • Mas só uma coisa... na verdade, você queria o que está descrito aqui (http://www.ambienteoffice.com.br/outlook/salvar_anexos_de_novas_mensagens_numa_pasta/), não?

    Você conseguiu fazer a rotina para salvar os anexos automaticamente na pasta desejada?

    Em relação a ter funcionado no 2007, meu único palpite restante seria atualizar o Outlook 2007 para o último Service Pack.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 22:41
    Moderador
  • Fala brother,

    O que eu queria era exatamente isso mesmo.

    Depois que coloquei o 2010 funcionou sem problemas.

    Em relação ao 2007 funcionou uma unica vez, depois que reinicie o micro não funcionou mais.

    O micro que tem o 2007 esta atualizado certinho com o último SP mas mesmo assim nada.

    Bom, o importante é que funcinou com o 2010 :)

    Abraço

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    sexta-feira, 9 de setembro de 2011 17:22

Todas as Respostas

  • Olá Regi boa tarde,

    Para executar este procedimento crie um módulo, neste módulo insira o seguinte algoritmo:

    Sub GetAttachments()
    On Error GoTo GetAttachments_err
    ' Declaração de variáveis
    Dim ns As Namespace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
    'Verifica no seu inbox se existe algum anexo de acordo com o assunto especificado
    If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
    "Nothing Found"
    Exit Sub
    End If
    ' Check each message for attachments
    For Each Item In Inbox.Items
    'Este nome entre aspas duplas é o assunto do email que contém o anexo, MUDE DE ACORDO COM SEU EMAIL
    If Item = "Email com anexo" Then
    ' Save any attachments found
    For Each Atmt In Item.Attachments
    ' Em filename você irá inserir o caminho de onde quer salvar seu anexo, MUDE DE ACORDO COM SEU AMBIENTE.
    FileName = "C:\Users\carlos\Desktop\anexos\" & Atmt.FileName
    Atmt.SaveAsFile FileName
    i = i + 1
    Next Atmt
    End If
    Next Item
    ' Show summary message
    If i > 0 Then
    MsgBox "I found " & i & " attached files." _
    & vbCrLf & "I have saved them into the C:\Users\carlos\Desktop\anexos." _
    & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
    Else
    MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
    ' Clear memory
    GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
    ' Handle errors
    GetAttachments_err:
    'MsgBox "An unexpected error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
    Resume GetAttachments_exit
    End Sub

    Depois adicione um commandbutton em seu formulário e adicione o seguinte algoritmo:

    Private Sub cmdBuscaAnexos_Click()
    GetAttachments
    End Sub

    Só fico te devendo a parte da alteração do nome do arquivo.

    Espero ter te ajudado com seu problema principal de salvar os anexos, se sim por favor qualificar como resposta.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    quinta-feira, 5 de maio de 2011 16:42
  • Carlos, fiz uma pesquisa para tentar encontrar um código que me ajudasse.

    O que idealizei como solução para esse problema, foi criar um código onde eu pudesse criar uma regra no outlook, que ao chegar um novo email que se encaixe nas regras pré-estabelecidas, ele executasse um script, que por sua vez estará atrelado a esse código. Ao executar o código o anexo seria salvo em uma pasta previamente informada. Como não tenho muito conhecimento em VBA, não sei se o que você desenvolveu funcionará da forma como expliquei, de uma forma ou de outra vou testar e caso tenha solucionado, darei o retorno.

    Mais uma vez agradeço a atenção desprendida.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:30
    sexta-feira, 6 de maio de 2011 00:37
  • Carlos estou precisando do mesmo código para salvar os anexos,fiz o procedimento porém na criação de regras o script não aparece,mesmo salvando o projeto.Como faço para aparecer o script na caixa de "seleção de script" na criação de regras do outlook?

     

    Agradeço desde Ja

    Kadu

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:30
    segunda-feira, 9 de maio de 2011 13:45
  • Amigos bom dia,

    Na verdade o código já tem uma regra, a regra esta sendo definida pelo assunto do email, ou seja, o código verifica se o assunto confere, se sim, é feito o download do anexo, no meu exemplo a regra é: se o assunto do email for "email com anexo" será feito download do anexo do respectivo email.

    Teste desta forma que você verá que o download do anexo será feito com sucesso.

    Espero ter ajudado, se sim por favor qualificar como resposta.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    • Sugerido como Resposta Carlos C Citrangulo Jr segunda-feira, 9 de maio de 2011 14:11
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    segunda-feira, 9 de maio de 2011 14:11
  • Ok.

    Muito obrigado Carlos.

     

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    segunda-feira, 9 de maio de 2011 15:01
  • Carlos, Criei o módulo e colei o código. Funcionou muito bem, porém, gostaria de se possível que o critério para que quando eu executasse a Macro, não fosse o assunto, e sim, se o email contiver um ou mais anexos, independente de sua extensão, o(s) anexo(s) fosse(m) salvo(s) no local especificado. Dessa forma eu criaria uma Regra para que a macro só fosse executada para os emails que obedecessem a mesma. Dessa forma seria melhor desabilitar as mensagens que são apresentadas quando o código é executado. Inclusive testei alguns códigos que encontrei usando uma Regra para executar um Script, e não funcionou, podes me orientar o porque? Outra forma que poderia ser utilizada é que quando chegasse um email eu criaria uma Regra para direciona-las automaticamente para uma pasta do Outlook, e na pasta eu executaria manualmente a macro. Para isso, na macro deveria constar o local para colocar o nome dessa pasta para que a macro não fosse executada na caixa de entrada. Podes nos ajudar Carlos, qualquer uma das formas serviria, de preferência a primeira opção. Grato pelo apoio e atenção. RegiCunha
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    quarta-feira, 11 de maio de 2011 03:16
  • Boa Tarde Carlos,

    Só mais uma coisa que notei agora...está funcionando perfeitamente..porém o anexo só é salvo com o campo "assunto" preenchido do jeito que está no código,ou seja,inteiro...tem há possibilidade de salvar a mensagem,contendo só uma parte do assunto ou palavra,exemplo: Assunto: "email com anexo código 123" ele reconhecer somente "email com anexo" e já salvar,fiz o teste e não conseguir..pode me ajudar,por favor?

     

    Agradeço desde ja

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    quinta-feira, 19 de maio de 2011 19:42
  • Kadu boa tarde,

    Não sei se você tem experiência nos fórums, mas mas quando sua dúvida é solucionada como você mesmo informou acima, você deve marcar a resposta como RESPOSTA, repare que no canto direito superior tem um V com uma interrogação em cima, para marcar como resposta você deve clicar neste ícone.

    Desta forma eu já passei 2 soluções, e ainda não foi marcada nenhuma como resposta, para que os fórums fiquem organizados, por favor MARCAR COMO RESPOSTAS as que serviram como solução, assim podemos continuar te ajudando.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    • Sugerido como Resposta Kadu001 sexta-feira, 20 de maio de 2011 02:09
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    quinta-feira, 19 de maio de 2011 20:04
  • Olá Carlos,

    Infelizmente não sabia dessa marcação,peço desculpas..quanto ao ícone mencionado,ele não fica disponível como um link,por isso não da pra "clicar"..não seria em outro lugar?testei com a sua mensagem a cima em um link do lado de "citação"..e o icone da intergogação como vc mencionou,apareceu no canto superior direito..é isso?caso não..fico a disposição para marcação certa da resposta...

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 02:12
  • Kadu, sem problemas, aproveito e tiro esta sua dúvida também.

    É importante que se fassamos bom uso do fórum assim mantemos o mesmo organizado e produtivo.

    Na verdade eu me expressei errado, você deve clicla somente no botao MARCAR COMO RESPOSTA, que é um V em verde, faz o seguinte da uma olhada nas respostas que te dei acima e veja se alguma tem um V em verde, as que tiverem e servirão como resposta, por favor marcar como Resposta. Caso não tenha nenhuma nesta condição é porque deve ter dado algum BUG, mas ainda sim você pode votar como útil, as que você achou útil, e a terceira opção é marcar como resposta e votar como útil ao mesmo tempo.

    OBS. Você deve estar logado.

    Depois da uma olhada com calma neste link: http://social.msdn.microsoft.com/Forums/pt-BR/help#310

    Este link citado acima explica todo o funcionamento do fórum, acho legal todos lerem esta FAQ.

    Espero ter ajudado, se sim, por favor MARCAR as RESPOSTAS que serviram.

    Abraços,


    Carlos Carvalho Citrangulo Junior
    Microsoft Certified Professional
    Microsoft Certified Desktop Support Technician
    MCTS Microsoft Windows Vista Configuration
    MCITP Enterprise Support Technician
    Profissional 5 Estrelas Microsoft
    http://carloscitrangulo.wordpress.com
    sexta-feira, 20 de maio de 2011 04:03
  • Carlos,

    Eu já havia notado o (sac) conforme mencionou,realmente não aparece nenhum link ou V em verde para marcar,deve esta ocorrendo algum BUG,de qualquer maneira como efetuado na 2 resposta,votei para conceder os seus créditos..td bem?quando voltar ao normal,eu marco a resposta como útil,conforme explicado,sem problemas :)

    Quanto a pergunta,é possível fazer dessa maneira?sem ter a frase toda do assunto?

     

    No Aguardo,

    Abraço

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 14:12
  • Kadu, o problema foi totalmente resolvido? O que mais falta?
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 15:44
    Moderador
  • Olá Benzadeus,

    O Carlos me ajudou bastante,só esta faltando uma coisa pra ficar perfeito:

    O script que ele me passou está funcionando corretamente,porém ele só funciona se o assunto estiver do jeito que está no código,gostaria de saber se tem a possibilidade de complementar o código da seguinte condição: a mensagem chega, se o assunto tiver pelo menos uma palavra ou frase que eu relatar no script,ele salva o anexo.ex:

    Assunto: "email com anexo"

    próximo e-mail..

    Assunto: "email com anexo dois"

    Independente do "dois" ele ler a frase "email com anexo" e salva o anexo na pasta.

    Pode me ajudar?

     

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 16:42
  • Pelo que percebi, o código fornecido não atua sobre novas mensagens recebidas. Se quiser que a macro trabalhe desta forma, dê uma olhada em http://www.ambienteoffice.com.br/outlook/salvar_anexos_de_novas_mensagens_numa_pasta/


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 18:58
    Moderador
  • Um detalhe importante: você deverá mudar o critério para que os anexos sejam salvos. Troque a linha

    If Right(Atmt.FileName, 4) = "xlsx" Then

    por, por exemplo:

    If Atmt.FileName Like = "Atr7700-tmp*.txt" Then


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:31
    sexta-feira, 20 de maio de 2011 19:00
    Moderador
  • Bom dia Felipe,

    Obrigado pela ajuda,porém houve um erro de expressão no igual,ao modificar o código solicitado,poderia verificar novamente por gentileza.

     

    Abraço

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 12:06
  • Erro meu. Retire o símbolo de igual.
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 12:26
    Moderador
  • Felipe,

    Infelizmente o arquivo não foi salvo na pasta...o do carlos funcionou porém gostaria que salvasse ou quando remetente eviasse(tipo uma regra) ou no assunto contiver alguma palavra ou frase(não necessariamente o assunto inteiro).

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 13:30
  • As propriedades que você quer acessar do item de e-mail são:

    No exemplo que te passei, Item é o parâmetro de entrada da regra, ou seja, o objeto de Email.

    A propriedade Subject corresponde ao assunto, que você quer testar.

    Poderia ser algo como:

     

    If mi.Subject Like "Texto*" Then

     


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 13:51
    Moderador
  • É Felipe,

    Muito obrigado pelo esforço,mas fiz alteração no código e nada..

    deve ter alguma condição que esta faltando..

     

     

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 14:25
  • Poste aqui o código completo que você está usando.
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    segunda-feira, 23 de maio de 2011 14:36
    Moderador
  • Felipe,

    Segue o codigo.

    Obs lembrando que ja tentei com o seu tmb.

    Abraço

    Sub GetAttachments()
    On Error GoTo GetAttachments_err
    ' Declaração de variáveis
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
    'Verifica no seu inbox se existe algum anexo de acordo com o assunto especificado
    If Inbox.Items.Count = 0 Then
    MsgBox "There are no messages in the Inbox.", vbInformation, _
    "Nothing Found"
    Exit Sub
    End If
    ' Check each message for attachments
    For Each Item In Inbox.Items
    'Este nome entre aspas duplas é o assunto do email que contém o anexo, MUDE DE ACORDO COM SEU EMAIL
    If mi.Subject Like "Email com anexo" Then
    ' Save any attachments found
    For Each Atmt In Item.Attachments
    ' Em filename você irá inserir o caminho de onde quer salvar seu anexo, MUDE DE ACORDO COM SEU AMBIENTE.
    FileName = "c:\anexos\" & Atmt.FileName
    Atmt.SaveAsFile FileName
    i = i + 1
    Next Atmt
    End If
    Next Item
    ' Show summary message
    If i > 0 Then
    MsgBox "I found " & i & " attached files." _
    & vbCrLf & "I have saved them into the c:\Documents and Settings\990885\Desktop\anexos" _
    & vbCrLf & vbCrLf & "Have a nice day.", vbInformation, "Finished!"
    Else
    MsgBox "I didn't find any attached files in your mail.", vbInformation, "Finished!"
    End If
    ' Clear memory
    GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub
    ' Handle errors
    GetAttachments_err:
    'MsgBox "An unexpected error has occurred." _
    & vbCrLf & "Please note and report the following information." _
    & vbCrLf & "Macro Name: GetAttachments" _
    & vbCrLf & "Error Number: " & Err.Number _
    & vbCrLf & "Error Description: " & Err.Description _
    , vbCritical, "Error!"
    Resume GetAttachments_exit
    End Sub

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:29
    quarta-feira, 25 de maio de 2011 14:43
  • Alguns comentários.

    Você misturou parte dos dois códigos. Use a declaração de variável obrigatória para evitar erros: http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/

    No código do Carlos, observe que o Objeto de mensagem analisado é Item, declarado como Object. No meu exemplo, Item é declarado como MailItem.

    Pelo que eu pude ver, se usar o código:

    Public Sub SalvarAnexo(Item As MailItem)
      
      Dim Atmt As Attachment
      Dim FileName As String
      
      'Mude o caminho da pasta destino que os anexos serão salvos aqui.
      'Não se esqueça de colocar a última barra invertida
      Const sPasta As String = "c:\temp\"
      
      'Especifique abaixo a regra sobre o assunto do e-mail para que ele queria salvar anexos:
      If Item.Subject Like "*Email com anexo*" Then
        For Each Atmt In Item.Attachments
          'Especifique abaixo a regra sobre o nome do anexo para que o mesmo possa ser salvo:
          If Atmt.FileName Like "*Email com anexo*" Then
            FileName = sPasta & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
            Atmt.SaveAsFile FileName
          End If
        Next Atmt
      End If
      
    End Sub

    Por último, não se esqueça de criar uma regra para executar esse script quando receber uma mensagem! Isso é explicado com detalhes aqui: http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/

     


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:29
    quarta-feira, 25 de maio de 2011 19:18
    Moderador
  • Ola Felipe,

    Desculpe pela demora,mas fiz o teste mencionado e infelizmente não funcionou.Ha uma possibilidade de fazer com que o anexo seja salvo na pasta pelo remetente e nao pelo assunto,acho que funcionaria melhor.

    Obrigado pela ajuda que está prestando.

     

    Abraço

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    quinta-feira, 2 de junho de 2011 15:14
  • Testei mais algumas vezes e está funcionando. Você leu o artigo que te passei para executar um script quando uma mensagem chega?

    Por remetente, o algo ficaria como algo abaixo:

    Public Sub SalvarAnexo(Item As MailItem)
      
      Dim Atmt As Attachment
      Dim FileName As String
      
      'Mude o caminho da pasta destino que os anexos serão salvos aqui.
      'Não se esqueça de colocar a última barra invertida
      Const sPasta As String = "c:\temp\"
      
      'Especifique abaixo o endereço de e-mail do remetente:
      If Item.SenderEmailAddress Like "benzadeus@ambienteoffice.com.br" Then
        For Each Atmt In Item.Attachments
          FileName = sPasta & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
          Atmt.SaveAsFile FileName
        Next Atmt
      End If
      
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:29
    quinta-feira, 2 de junho de 2011 15:18
    Moderador
  • Valeu Felipe,

    Mas ao depurar o código deu erro nessa linha "If Item.SenderEmailAddress = "email@teste.com.br" Then"

    erro : 438

    Obs: troquei o e-mail.

    Obrigado novamente,

     

    Kadu

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 7 de junho de 2011 11:40
  • Hum... estou achando que você mudou algo importante no código.

    Minha opinião é que você trocou o cabeçalho de:

    Public Sub SalvarAnexo(Item As MailItem)

    para:

    Public Sub SalvarAnexo()

    porque não estava conseguindo executar a macro. Estou certo?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 7 de junho de 2011 12:59
    Moderador
  • Pior que não...hehehe..

     

    Só copiei e colei...vc chegou a testar?

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 7 de junho de 2011 14:13
  • Cheguei a testar sim, está funcionando.

    Só para confirmar, você seguiu os passos de http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 7 de junho de 2011 15:00
    Moderador
  • Boa tarde,

    Pessoal, li os posts, mas tentei fazer e não deu certo. Alguém pode me ajudar?

    Desde já obrigado!

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 9 de agosto de 2011 19:51
  • Onde está tendo dificuldade?
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    terça-feira, 9 de agosto de 2011 19:59
    Moderador
  • Kadu001, para só uma parte da frase do assusto, faça como segue:

    Por exemplo: Este é o assunto "email com anexo código 123"

    dim strAssunto as string, strParteDoAssusnto as string

    strAssunto="email com anexo código 123"

    strParteDoAssunto=Left(strAssunto,Len("email com anexo código "))

    Abraço.

    Raf.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    domingo, 21 de agosto de 2011 12:33
  • Kadu001,

    Na hora que seu programa chega no ponto abaixo, de verificar o assunto faça o seguinte:

    ‘Crie 2 variáveis string, uma para pegar o assunto inteiro = Item, e outra para transformá-la no pedaço que você quer. Veja:

    Dim strAssunto as string, strParteDoAssusnto as string

    For Each Item In Inbox.Items

     ‘vai para essa função abaixo, que arruma o assunto para a parte que você quer (a função está criada mais abaixo)

      strAssunto = Item

    strParteDoAssunto = fSetParteDoAssunto(   strAssunto )

    If Left(Item, 23) = strParteDoAssunto Then

     ' Save any attachments found

     For Each Atmt In Item.Attachments

     ' Em filename você irá inserir o caminho de onde quer salvar seu anexo, MUDE DE ACORDO COM SEU AMBIENTE.

     FileName = "C:\Pasta\" & Atmt.FileName

     Atmt.SaveAsFile FileName

     i = i + 1

     Next Atmt

     End If

     Next Item

    .

    .

    .

    abaixo segue a função que pega só o pedaço que você quer do assusnto

    Private Function fSetParteDoAssunto    (strPala2 As String) as String

      Dim strPala1 As String

      strPala1 = strPala2

      strParteDoAssusnto = Left(“email com anexo código “, Len( strPala1 ))

    End Function

    Dá certo, porque eu adequei o assunto na mesma rotina que você está usando e funciona. Por favor, fale-me se você conseguiu? Grata Raf. 21/08/2011.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:32
    domingo, 21 de agosto de 2011 13:10
  • Pessoal, gostaria de uma ajuda. Criei este script copiando de um site indicado por vocês:

    Public Sub SalvarAnexo(Item As MailItem)
     
     Dim Atmt As Attachment
     Dim FileName As String
     
     For Each Atmt In Item.Attachments
      If Right(Atmt.FileName, 4) = "xlsx" Then
       FileName = "C:\temp\" & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
       Atmt.SaveAsFile FileName
      End If
     Next Atmt
     
    End Sub

    Bom, no meu caso eu alterei "xlsx" para "xml" e no campo "c:\temp\" alterei para "t:\" que é minha unidade de rede onde serão copiados os arquivos.

    Seguinte, crio a regra normalmente no outlook para quando chegar e-mail o script rodar e tudo mas não acontece nada.

    Testei em uma dúzia de Outlook aqui (2007) e acontece o mesmo: nada.

    Com não sou expert em Visual Basic, estou achando que deixei de fazer algum passo importante.

    Fiz o seguinte: abri o MVB no outlook a partir do alt+11, botão direito em cima de Projeto 1 e Inserir Módulo, alterei conforme informei acima, cliquei em Arquivo-Salvar VbaProject.otm, depois em Fechar e voltar para o Microsoft Outlook, Regras e Alertas, Nova regra, Verificar mensagem quando chegarem, regra aplicada a cada mensagem recebida, executar um script (Projeto1.SalvarAnexo), sem exceções, Concluir e OK.

    Agradeço imensamente quem puder desvendar este mistério.

    Há outra dúvida, quando as mensagens chegarem e o script rodar, automaticamente são copiadas ou é necessário intervenção do usuário, tipo abri a mensagem ou outra ação ?

    Muito obrigado.


    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    quarta-feira, 31 de agosto de 2011 16:29
  • Você conseguiu fazer funcionar o exemplo em http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/?
    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    sexta-feira, 2 de setembro de 2011 01:32
    Moderador
  • Fala amigão, fiz este procedimento sim. Alias o codigo que copie na minha pergunta é exatamente deste site.


    Ja fiz de tudo mas não tem jeito, ele simplesmente não funciona.

    A mensagem chega e tudo mas não acontece nada, a regra ta certinha e tal mas nada de fucionar.

    Fogo isso viu, toda hora tenho que estar verificando e-mail par ver se chegou nota fiscal pra copiar na munheca e jogar na pasta.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 13:03
  • Você habilitou as macros do seu Outlook já?

     

    Em Arquivo >> Opções >> Central de Confiabilidade >> Configurações da Central de Confiabilidade >> Configurações de Macro >> Habilitar todas as macros.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 14:21
    Moderador
  • Fala brother.

    Acabei de fazer e nada :(

    Ate reinstalei o Outlook e nada...

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 20:29
  • Você sabe se a rotina está sendo executada quando chega uma mensagem?

     

    Aperte F9 na linha do procedimento que você quer que execute quando chega uma mensagem. Dessa forma, você criará um ponto de interrupção e depurará a rotina.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 20:39
    Moderador
  • Vê se estou certo: apertei f9 na linha:


    For Each Atmt In Item.Attachments

    Aí a linha ficou vermelha com um ponto ao lado, envivei um e-mail com anexo xml mas nada aconteceu...

    Caramba, pior que todo micro que testo é a mesma coisa não é possivel...

     


    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 21:00
  • Não estamos falando então do mesmo exemplo.

     

    O exemplo a que estou me referindo é o do link http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/, e nele não há essa linha de código.

    Tente fazê-lo funcionar, e acione o F9 na linha

    Sub MensagemRecebida(Item As MailItem)

    OK?

    Em seguida, envie um e-mail pra você mesmo.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    segunda-feira, 5 de setembro de 2011 21:38
    Moderador
  • Cara obrigadão pela paciencia viu :)

    Teste este outro script e não acontece nada...

    E a regra esta certinho (executar script em toda as mensagens que chegarem)

    O estranho é que em todos os outlooks aqui da empresa estão assim :(

    Estou usando o office 2007 original e nada...

    Caraca to quase indo pra um terreiro :)

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 12:23
  • Isso não é bom, não entendo o que está acontecendo. Será que é algum pequeno detalhe que está passando batido, pelo fato do seu Outlook ser 2007 e o do exemplo ser o 2010?

    Em paralelo, vou revisar o texto, ver se está faltando alguma coisa. Se eu descobrir alguma coisa que está faltando, te falo.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 12:52
    Moderador
  • Hmm bem pensando,


    Vou instalar um 2010 aqui é fazer o teste, vai que da certo.


    Obrigadão mais uma vez pela ajuda.

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 12:59
  • Fala amigão, cara obrigado pela ajuda.

    Instalei o 2010 e funcionou beleza :)

    Agora pra deixar o negócio ainda mais intrigante, se eu te falar que em um unico micro aqui que tem Outlook 2007 funcionou ?

    E detalhe: neste micro que funiconou, desligaram ele na hora do almoço e agoraa regra deste 2007 não funciona mais ?

    ehheheheheheheh vai entender

    Bom, mais o que interessa pra mim é que funcionou no micro que precisava funcionar.

    Valeu mais uma vez pela grande imensa ajuda.

    Abraço...

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 18:44
  • Mas só uma coisa... na verdade, você queria o que está descrito aqui (http://www.ambienteoffice.com.br/outlook/salvar_anexos_de_novas_mensagens_numa_pasta/), não?

    Você conseguiu fazer a rotina para salvar os anexos automaticamente na pasta desejada?

    Em relação a ter funcionado no 2007, meu único palpite restante seria atualizar o Outlook 2007 para o último Service Pack.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    terça-feira, 6 de setembro de 2011 22:41
    Moderador
  • Fala brother,

    O que eu queria era exatamente isso mesmo.

    Depois que coloquei o 2010 funcionou sem problemas.

    Em relação ao 2007 funcionou uma unica vez, depois que reinicie o micro não funcionou mais.

    O micro que tem o 2007 esta atualizado certinho com o último SP mas mesmo assim nada.

    Bom, o importante é que funcinou com o 2010 :)

    Abraço

    • Marcado como Resposta RegiCunha domingo, 30 de outubro de 2011 13:33
    sexta-feira, 9 de setembro de 2011 17:22
  • Galera, beleza? Essa discussão é antiga, mas hoje aconteceu comigo o mesmo problema do Alexandre_Oliveira. tenho uma macro, igual a do exemplo acima, que sempre funcionou bem em 3 maquinas do escritório.

    De 1 dia para o outro parou de rodar, como se o outlook não pudesse acessar a regra.

    Mudei as configurações de confiabilidade, mudei o endereço da script, recriei a regra, reiniciei varias vezes o outlook e as maquinas e nada. O mais estranho é que ja estava usando o Outlook 2010. Agora continuo com o problema.

    Se alguém tiver uma dica de como posso tertar novamente eu agradeço. Não sou do suporte, portanto queria testar todas as possibilidades antes de abrir um torturoso chamado.

    Agradeço!

    Cavallari

    quarta-feira, 28 de novembro de 2012 15:58
  • Perdi o dia todo hoje e só consegui agora, vale a pena ressaltar que depois de feito tudo, tem que fechar e abrir novamente o Outlook.

    Abraços!

    quarta-feira, 2 de janeiro de 2013 03:12
  • Galera estou precisando de uma ajuda.

    Não entendo muito bem sobre VBA, e preciso de um código que me permita salvar um anexo de um email do Outlook em uma pasta no computador. Porém, os arquivos que serão salvos na pasta no computador estarão dentro de uma pasta especifica no outlook.

    Alguém sabe como posso fazer isso?

    Obrigada,

    segunda-feira, 19 de agosto de 2013 17:13
  • Boa noite!

    tenho uma necessidade semelhante e gostaria se saber se é possível incluir no código citado uma maneira de mover o e-mail para outra pasta apor ter sido salvo o anexo?

    Complemento: O código funcionou como prometido acima, mas preciso manter certa organização devido ao volume de e-mail que recebo por isso a pergunta.

    Obrigado

    segunda-feira, 25 de novembro de 2013 22:05
  • Olá,

    Para manter o fórum organizado, sugiro criar um novo tópico referenciando o link deste tópico e explicando lá sua necessidade.

    Obrigado.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 25 de novembro de 2013 23:15
    Moderador
  • Bom dia a todos, 

    Eu coloquei este código e rodou perfeitamente por muito tempo, porem de quarta-feira passada 15/03/17, a macro parou de salvar os anexos sem motivos aparente, mudei até a pasta, criei até em outro pc a mesma regra e não funciona mais, alguém tem algum link ou modo onde eu consiga encontrar o problema?

    Alguns comentários.

    Você misturou parte dos dois códigos. Use a declaração de variável obrigatória para evitar erros: http://www.ambienteoffice.com.br/officevba/declaracao_de_variavel/

    No código do Carlos, observe que o Objeto de mensagem analisado é Item, declarado como Object. No meu exemplo, Item é declarado como MailItem.

    Pelo que eu pude ver, se usar o código:

    Public Sub SalvarAnexo(Item As MailItem)
      
      Dim Atmt As Attachment
      Dim FileName As String
      
      'Mude o caminho da pasta destino que os anexos serão salvos aqui.
      'Não se esqueça de colocar a última barra invertida
      Const sPasta As String = "c:\temp\"
      
      'Especifique abaixo a regra sobre o assunto do e-mail para que ele queria salvar anexos:
      If Item.Subject Like "*Email com anexo*" Then
        For Each Atmt In Item.Attachments
          'Especifique abaixo a regra sobre o nome do anexo para que o mesmo possa ser salvo:
          If Atmt.FileName Like "*Email com anexo*" Then
            FileName = sPasta & Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
            Atmt.SaveAsFile FileName
          End If
        Next Atmt
      End If
      
    End Sub

    Por último, não se esqueça de criar uma regra para executar esse script quando receber uma mensagem! Isso é explicado com detalhes aqui: http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/

     


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    terça-feira, 21 de março de 2017 13:08
  • Esse código funcionou, obrigado !

    Gostaria de saber se há como programar um horário para atualizar ou se é possível programar atualizar de acordo com a atualização automática do e-mail.

    segunda-feira, 17 de junho de 2019 19:15