none
Adicionar data ao nome do arquivo RRS feed

 > 

Respostas

  • Question
    Entrar para Votar
    1
    Entrar para Votar

    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

  • Question
    Entrar para Votar
    0
    Entrar para Votar
    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
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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
    |
  • Question
    Entrar para Votar
    1
    Entrar para Votar

    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
  • Question
    Entrar para Votar
    0
    Entrar para Votar
    Tinha um erro no script, corrigido!

    Fábio de Paula Junior

    quinta-feira, 22 de novembro de 2012 12:23
    |
    Moderador
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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
    |
  • Question
    Entrar para Votar
    1
    Entrar para Votar

    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
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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
    |
  • Question
    Entrar para Votar
    0
    Entrar para Votar

    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
    |