Jump to content

How to create folder name extensions move?


youtuber
 Share

Recommended Posts

#RequireAdmin
#include <File.au3>
#include <Array.au3>
#include <String.au3>

Global $sFilters = "*.psd;*.jpg;*.png;*.gif;*.ico;*.txt;*.mp3"
Global $aFilters = StringRegExp($sFilters, "\.(...?)", 3)
Global $aFolder

_FileSelectaFolder()

Func _FileSelectaFolder()
Local $aFolder = FileSelectFolder("Select folder", "", 1)

$search = FileFindFirstFile($aFolder & "\*.*")

If $search = -1 Then
    MsgBox(0, "Error", "No files")
    Exit
EndIf

While 1
    $sFile = FileFindNextFile($search)
    If @error Then ExitLoop
    $MovieName = $aFilters
        For $i = 1 To UBound($MovieName) - 1
        FileMove($aFolder & $sFile, "D:\New Folder\" & $MovieName[$i] & " Archive" & "\" & $sFile,8)
        Next
WEnd
FileClose($search)

 

Link to comment
Share on other sites

youtuber,

Based on your explanation I think this will work...

;#RequireAdmin
#include <File.au3>
#include <Array.au3>
#include <String.au3>

Global $aFilters = ['psd','jpg','png','gif','ico','txt','mp3']
Global $aFolder

_FileSelectaFolder()

Func _FileSelectaFolder()
    Local $aFolder = FileSelectFolder("Select folder", "", 1)
    if $aFolder = '' then exit ConsoleWrite('canceled by user' & @CRLF) ; <--- don't want this falling through to the move code

    $search = FileFindFirstFile($aFolder & "\*.*")

    If $search = -1 Then
        MsgBox(0, "Error", "No files")
        Exit
    EndIf

    While 1
        $sFile = FileFindNextFile($search)
        If @error Then ExitLoop
        $MovieName = $aFilters
        For $i = 1 To UBound($MovieName) - 1
            if stringregexp($sFile,'.*\.(.*)',3)[0] = $MovieName[$i] then
                FileMove($aFolder & '\' & $sFile, @scriptdir & '\testb\' & $MovieName[$i] & " Archive" & "\" & $sFile, 8)
            endif
        Next
    WEnd
    FileClose($search)
EndFunc   ;==>_FileSelectaFolder

kylomas

note - dest folder name changed for testing...

Forum Rules         Procedure for posting code

"I like pigs.  Dogs look up to us.  Cats look down on us.  Pigs treat us as equals."

- Sir Winston Churchill

Link to comment
Share on other sites

@kylomas how if the files are in subdirectory The error message?

Is code right?

If $MovieName[0] = 0 Then ExitLoop

 

#include <File.au3>
#include <Array.au3>
#include <String.au3>

Global $aFilters = ['psd','jpg','png','gif','ico','txt','mp3']
Global $aFolder

_FileSelectaFolder()

Func _FileSelectaFolder()
    Local $aFolder = FileSelectFolder("Select folder", "", 1)
    if $aFolder = '' then exit ConsoleWrite('canceled by user' & @CRLF) ; <--- don't want this falling through to the move code

    $search = FileFindFirstFile($aFolder & "\*.*")

    If $search = -1 Then
        MsgBox(0, "Error", "No files")
        Exit
    EndIf

    While 1
        $sFile = FileFindNextFile($search)
        If @error Then ExitLoop
        $MovieName = $aFilters
        If $MovieName[0] = 0 Then ExitLoop ;?
        For $i = 1 To UBound($MovieName) - 1
            if stringregexp($sFile,'.*\.(.*)',3)[0] = $MovieName[$i] then
                FileMove($aFolder & '\' & $sFile, @scriptdir & '\testb\' & $MovieName[$i] & " Archive" & "\" & $sFile, 8)
            endif
        Next
    WEnd
    FileClose($search)
EndFunc   ;==>_FileSelectaFolder

 

If there are files in subfolders 
it's not working  your code! :(

69689ab06df0476498ffeb394165553d.png

 

 

Edited by youtuber
Link to comment
Share on other sites

youtuber,

Perhaps you should describe what you want to do.  There is nothing in your code to suggest that you want to process sub-directories.

Use google translate from your native language to make it easier.

kylomas

Forum Rules         Procedure for posting code

"I like pigs.  Dogs look up to us.  Cats look down on us.  Pigs treat us as equals."

- Sir Winston Churchill

Link to comment
Share on other sites

youtuber,

Alright, had an hour to kill.

This code will "copy" the files.  Change it to "move" if you like.  Nota bene - if you have multiple files named "notes.txt" coming from different directories they will all be overwritten by the last instance of "notes.txt.  I provided two examples of the copy code because of this, one that overwrites as described and one that appends the source dir struct to prevent overwriting. 

#include <File.au3>
#include <Array.au3>
#include <String.au3>

Local $sFilters = '*.psd;*.jpg;*.png;*.gif;*.ico;*.txt;*.mp3'

Local $sFolder = FileSelectFolder("Select folder", "C:\K", 7)
If $sFolder = '' Then Exit ConsoleWrite('canceled by user' & @CRLF) ; <--- don't want this falling through to the move code

Local $aFiles = _FileListToArrayRec($sFolder, $sFilters, $FLTAR_FILES, $FLTAR_RECUR, $FLTAR_NOSORT, $FLTAR_FULLPATH)
If @error Then Exit MsgBox(17, 'FileListToArray Error', 'Extended = ' & @extended)

;_arraydisplay($aFiles)

For $i = 1 To $aFiles[0]

    ConsoleWrite('copying ' & $aFiles[$i] & @CRLF)

    ; this one will overwrite duplicately named files
    ;If FileCopy($aFiles[$i], @ScriptDir & '\testb\' & StringRegExpReplace($aFiles[$i], '.*\.(.*)', '$1') & " Archive" & "\" & StringRegExpReplace($aFiles[$i], '.*\\(.*)', '$1'), 8) = 0 Then _
    ;       Exit MsgBox(17, 'error', 'file copy failed for file = ' & $aFiles[$i])

    ; this one will create a sub dir struct from source file preventing overwriting files
    If FileCopy($aFiles[$i], @ScriptDir & '\testb\' & StringRegExpReplace($aFiles[$i], '.*\.(.*)', '$1') & " Archive" & "\" & StringTrimLeft($aFiles[$i], 2), 9) = 0 Then _
            Exit MsgBox(17, 'error', 'file copy failed for file = ' & $aFiles[$i])

Next

kylomas

Edited by kylomas

Forum Rules         Procedure for posting code

"I like pigs.  Dogs look up to us.  Cats look down on us.  Pigs treat us as equals."

- Sir Winston Churchill

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...