none
Mover e renomear arquivo RRS feed

  • Pergunta

  • Olá pessoal!

    Algum poderia me auxiliar a otimizar o codigo abaixo?

    Preciso mover os arquivos de uma pasta origem para outra destino e renomear o arquivo movido, porem só posso mover algum arquivo caso não exista nenhum arquivo na pasta destino.

    Acho que não precisa desse segundo loop, ja que será movido um arquivo de cada vez, não é?

    Algum consegue me ajudar?

    Dim ObjFSO
    Dim ObjFolderA
    Dim ObjFolderB
    Dim ObjFiles
    Dim ObjFile
     
    'Creating File System Object
    Set ObjFSO = CreateObject("Scripting.FileSystemObject")
     
    'Getting the Folder Object
    Set ObjFolderA = ObjFSO.GetFolder("C:\Origem")
    Set ObjFolderB = ObjFSO.GetFolder("C:\Destino")
     
    'Moving Files One by One to Output Destination Folder
    For each ObjFile in ObjFolderA.Files
        Do While True
            If ObjFolderB.Files.Count = 0 Then
                ObjFSO.MoveFile ObjFile.Path, ObjFolderB.Path & "\"
    			'MsgBox("One file moved successfully!")
    			
    			'Getting the list of Files
    			Set ObjFiles = ObjFolderB.Files
    
    			'Rename File
    			For Each StrFile In ObjFiles
    				If ((ObjFSO.FileExists(StrFile.Path)) And (StrFile.Name <> "extrato.ofx")) Then
    					StrFile.Name = "extrato.ofx"
    					'MsgBox("File renamed successfully!")
    				End If
    				Exit for	
    			Next			
    			
                Exit Do
            End If
        Loop
    Next
    
    Set ObjFSO = Nothing
    Set ObjFolderA = Nothing
    Set ObjFolderB = Nothing
    Set ObjFiles = Nothing
    Set ObjFile = Nothing

    Obrigado,

    Júlio C. Franco





    terça-feira, 19 de novembro de 2013 20:26

Respostas

  • Para a Segunda opção use isto

    Dim ObjFSO
    Dim ObjFolderA
    Dim ObjFolderB
    Dim ObjFiles
    Dim ObjFile
    
    strPathOrigem="C:\Origem"
    strPathDestino="C:\Destino"
     
    'Creating File System Object
    Set ObjFSO = CreateObject("Scripting.FileSystemObject")
     
    'Getting the Folder Object
    Set ObjFolderA = ObjFSO.GetFolder(strPathOrigem)
    Set ObjFolderB = ObjFSO.GetFolder(strPathDestino)
     
    'Moving Files One by One to Output Destination Folder
    For each ObjFile in ObjFolderA.Files
    	
        Do While ContaArquivos(strPathDestino) > 0
    		'Opa, ainda tem arquivos no destino então
    		'espere um pouco (5 segundos)
    		wscript.sleep 5000
        Loop
    	
    	'Move e já renomeia
        ObjFSO.MoveFile ObjFile.Path, ObjFolderB.Path & "\extrato.ofx"
    	
    	
    Next
    msgbox "fim"
    
    Set ObjFSO = Nothing
    Set ObjFolderA = Nothing
    Set ObjFolderB = Nothing
    Set ObjFiles = Nothing
    Set ObjFile = Nothing
    
    'Funções
    function ContaArquivos(strFolderDestino)
    	Set fso = CreateObject("Scripting.FileSystemObject")
    	Set folder = fso.GetFolder(strFolderDestino)
    	Set Files = folder.Files 
    
    	ContaArquivos= Files.Count
    end function

    Ref.:

    MoveFile Method

    http://msdn.microsoft.com/en-us/library/2wcf3ba6(v=vs.84).aspx


    Fábio de Paula Junior

    quarta-feira, 20 de novembro de 2013 20:29
    Moderador

Todas as Respostas

  • Júlio,

    Criei uma função que conta os arquivos então apenas adicionei um IF no seu script.

    Eu não conferi o seu código.

    msgbox ContaArquivos("C:\temp")
    
    Dim ObjFSO
    Dim ObjFolderA
    Dim ObjFolderB
    Dim ObjFiles
    Dim ObjFile
     
    'Creating File System Object
    Set ObjFSO = CreateObject("Scripting.FileSystemObject")
     
    'Getting the Folder Object
    Set ObjFolderA = ObjFSO.GetFolder("C:\Origem")
    Set ObjFolderB = ObjFSO.GetFolder("C:\Destino")
    
    
    if ContaArquivos("C:\Destino") = 0 then
    
    	'Moving Files One by One to Output Destination Folder
    	For each ObjFile in ObjFolderA.Files
    		Do While True
    			If ObjFolderB.Files.Count = 0 Then
    				ObjFSO.MoveFile ObjFile.Path, ObjFolderB.Path & "\"
    				'MsgBox("One file moved successfully!")
    				
    				'Getting the list of Files
    				Set ObjFiles = ObjFolderB.Files
    
    				'Rename File
    				For Each StrFile In ObjFiles
    					If ((ObjFSO.FileExists(StrFile.Path)) And (StrFile.Name <> "extrato.ofx")) Then
    						StrFile.Name = "extrato.ofx"
    						'MsgBox("File renamed successfully!")
    					End If
    					Exit for	
    				Next			
    				
    				Exit Do
    			End If
    		Loop
    	Next
    	
    end if
    
    Set ObjFSO = Nothing
    Set ObjFolderA = Nothing
    Set ObjFolderB = Nothing
    Set ObjFiles = Nothing
    Set ObjFile = Nothing
    
    'Funções
    function ContaArquivos(strFolderDestino)
    	Set fso = CreateObject("Scripting.FileSystemObject")
    	Set folder = fso.GetFolder(strFolderDestino)
    	Set Files = folder.Files 
    
    	ContaArquivos= Files.Count
    end function

    Ref.:

    GetFolder Object

    http://msdn.microsoft.com/en-us/library/f1xtf7ta(v=vs.84).aspx


    Fábio de Paula Junior


    quarta-feira, 20 de novembro de 2013 20:04
    Moderador
  • Achei um pouco confuso.

    Exemplo:

    1)Vc tem 6 arquivos, eu verifico se existem arquivos na pasta de destino e se não existir eu copio os 6 arquivos?

    ou

    2) Vou ter que verificar se existem arquivos, copiar apenas 1, aguardar alguma ação que retira este arquivo de lá e em seguida começar a verficação para outro arquivo da pasta de origem?


    Fábio de Paula Junior

    quarta-feira, 20 de novembro de 2013 20:13
    Moderador
  • Para a Segunda opção use isto

    Dim ObjFSO
    Dim ObjFolderA
    Dim ObjFolderB
    Dim ObjFiles
    Dim ObjFile
    
    strPathOrigem="C:\Origem"
    strPathDestino="C:\Destino"
     
    'Creating File System Object
    Set ObjFSO = CreateObject("Scripting.FileSystemObject")
     
    'Getting the Folder Object
    Set ObjFolderA = ObjFSO.GetFolder(strPathOrigem)
    Set ObjFolderB = ObjFSO.GetFolder(strPathDestino)
     
    'Moving Files One by One to Output Destination Folder
    For each ObjFile in ObjFolderA.Files
    	
        Do While ContaArquivos(strPathDestino) > 0
    		'Opa, ainda tem arquivos no destino então
    		'espere um pouco (5 segundos)
    		wscript.sleep 5000
        Loop
    	
    	'Move e já renomeia
        ObjFSO.MoveFile ObjFile.Path, ObjFolderB.Path & "\extrato.ofx"
    	
    	
    Next
    msgbox "fim"
    
    Set ObjFSO = Nothing
    Set ObjFolderA = Nothing
    Set ObjFolderB = Nothing
    Set ObjFiles = Nothing
    Set ObjFile = Nothing
    
    'Funções
    function ContaArquivos(strFolderDestino)
    	Set fso = CreateObject("Scripting.FileSystemObject")
    	Set folder = fso.GetFolder(strFolderDestino)
    	Set Files = folder.Files 
    
    	ContaArquivos= Files.Count
    end function

    Ref.:

    MoveFile Method

    http://msdn.microsoft.com/en-us/library/2wcf3ba6(v=vs.84).aspx


    Fábio de Paula Junior

    quarta-feira, 20 de novembro de 2013 20:29
    Moderador