none
Adicionar data ao nome do arquivo RRS feed

Respostas

  • Pode ser isso, mas gerou alguma mensagem de erro?

    Public Sub BATAVO(Email As MailItem)
    	Dim DiretorioAnexos As String
    	Dim strDATAHORA As String
    	Dim NomeArquivo As String
    	
    	DiretorioAnexos = "C:\sistema\Visual_rodopar\Auxiliares\XML_CLIENTES\Batavo\"
    	
    	strDATAHORA =  right("0" & day(now),2) & right("0" & month(now),2) & year(now) & _
    				" " & right("0" & hour(now),2) & right("0" & minute(now),2)
    
    	Dim MailID As String
    	Dim Mail As Outlook.MailItem
    
    	MailID = Email.EntryID
    	Set Mail = Application.Session.GetItemFromID(MailID)
    
    	i=1
    	For Each Anexo In Mail.Attachments
    		If Right(Anexo.FileName, 3) = "xml" Then
    			NomeArquivo=left(Anexo.FileName,len(Anexo.FileName)-4) & "_" & strDATAHORA & right(Anexo.FileName,4)
    			Anexo.SaveAsFile DiretorioAnexos & NomeArquivo 
    			
    		End If
    	Next
    
    	Set Mail = Nothing
     End Sub


    Fábio de Paula Junior

    quinta-feira, 22 de novembro de 2012 13:34
    Moderador

Todas as Respostas

  • Poderia postar seu código? não é dificil adicionar esta alteração.

    Fábio de Paula Junior

    quinta-feira, 22 de novembro de 2012 11:03
    Moderador
  • Fabio!!

    Obrigado pela resposta e interesse em ajudar!!!

    Segue meu codigo

    Public Sub BATAVO(Email As MailItem)
         Dim DiretorioAnexos As String
         DiretorioAnexos = "C:\sistema\Visual_rodopar\Auxiliares\XML_CLIENTES\Batavo\"
     
        Dim MailID As String
         Dim Mail As Outlook.MailItem
        
         MailID = Email.EntryID
         Set Mail = Application.Session.GetItemFromID(MailID)
            
         For Each Anexo In Mail.Attachments
             If Right(Anexo.FileName, 3) = "xml" Then
                 Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
             End If
         Next
        
         Set Mail = Nothing
     End Sub

    quinta-feira, 22 de novembro de 2012 11:58
  • Não tenho como testar o script, me avise se funcionou:

    Public Sub BATAVO(Email As MailItem)
    	Dim DiretorioAnexos As String
    	DiretorioAnexos = "C:\sistema\Visual_rodopar\Auxiliares\XML_CLIENTES\Batavo\"
    	
    	strDATAHORA =  right("0" & day(now),2) & right("0" & month(now),2) & year(now) & _
    				" " & right("0" & hour(now),2) & right("0" & minute(now),2)
    
    	Dim MailID As String
    	Dim Mail As Outlook.MailItem
    
    	MailID = Email.EntryID
    	Set Mail = Application.Session.GetItemFromID(MailID)
    
    	i=1
    	For Each Anexo In Mail.Attachments
    		If Right(Anexo.FileName, 3) = "xml" Then
    			NomeArquivo=left(Anexo.FileName,len(Anexo.FileName)-4) & "_" & strDATAHORA & right(Anexo.FileName,4)
    			Anexo.SaveAsFile DiretorioAnexos & NomeArquivo 
    			
    		End If
    	Next
    
    	Set Mail = Nothing
     End Sub




    Fábio de Paula Junior


    quinta-feira, 22 de novembro de 2012 12:17
    Moderador
  • Tinha um erro no script, corrigido!

    Fábio de Paula Junior

    quinta-feira, 22 de novembro de 2012 12:23
    Moderador
  • Fabio !!

    Nao funcionou!!

    Eu sem entender de programação estive analisando o script.. 

    nao estaria faltando declarar uma variavel "NomeArquivo" ?

    quinta-feira, 22 de novembro de 2012 13:11
  • Pode ser isso, mas gerou alguma mensagem de erro?

    Public Sub BATAVO(Email As MailItem)
    	Dim DiretorioAnexos As String
    	Dim strDATAHORA As String
    	Dim NomeArquivo As String
    	
    	DiretorioAnexos = "C:\sistema\Visual_rodopar\Auxiliares\XML_CLIENTES\Batavo\"
    	
    	strDATAHORA =  right("0" & day(now),2) & right("0" & month(now),2) & year(now) & _
    				" " & right("0" & hour(now),2) & right("0" & minute(now),2)
    
    	Dim MailID As String
    	Dim Mail As Outlook.MailItem
    
    	MailID = Email.EntryID
    	Set Mail = Application.Session.GetItemFromID(MailID)
    
    	i=1
    	For Each Anexo In Mail.Attachments
    		If Right(Anexo.FileName, 3) = "xml" Then
    			NomeArquivo=left(Anexo.FileName,len(Anexo.FileName)-4) & "_" & strDATAHORA & right(Anexo.FileName,4)
    			Anexo.SaveAsFile DiretorioAnexos & NomeArquivo 
    			
    		End If
    	Next
    
    	Set Mail = Nothing
     End Sub


    Fábio de Paula Junior

    quinta-feira, 22 de novembro de 2012 13:34
    Moderador
  • Fabio!!

    Deu Certo com o primeiro exemplo!!!

    Eu que comi "Mosca" as macros da maquina que testei estavam desabilitadas...

    mto obrigado pelo ajuda....

    Abraços.

    quinta-feira, 22 de novembro de 2012 13:43
  • Fabio, estou com um problema semelhante. Todos meus anexos tem o mesmo nome. Testei com a data e hora como você fez e também com um contador que criei e não funcionou. Meu script salva apenas 1 arquivo.

    Pode me ajudar?

    Public Sub ProcessarCarport(Email As MailItem)
         Dim DiretorioAnexos As String
         
         DiretorioAnexos = "D:\Trabalho Danilo\Campanhas\Macro\CARPORT\"
         
         Dim MailID As String
         Dim Mail As Outlook.MailItem
         Dim Nome As String
         
         
         MailID = Email.EntryID
         Set Mail = Application.Session.GetItemFromID(MailID)
         
         count = 1
             
         For Each Anexo In Mail.Attachments
         
                Arquivo = Left(Anexo.FileName, Len(Anexo.FileName) - 3) & count & ".csv"
    
                 Anexo.SaveAsFile DiretorioAnexos & Arquivo
                 count = count + 1
                         
         Next
         
         Set Mail = Nothing
         count = 1
    End Sub

    terça-feira, 31 de maio de 2016 18:49