VBS to be an "Alphabetic File Sorter"

I need a VBS to do the following - create new folders (subfolders) inside a main folder I specify, which name is based on the initial characters of files' name. First I must specify if it is only the first character, or the two, or three (and so on) inital characters of files' name. For example, inside the main folder there are 4 files : aaaa.ext, abbb.ext, accc.ext, addd.ext => I specify that the subfolders' name will be equal to the two inital characters of files' name => it automatically :
creates aa\ and moves aaaa.ext inside aa\;
creates ab\ and moves abbb.ext inside aa\;
creates ac\ and moves accc.ext inside ac\;
creates ad\ and moves addd.ext inside ad\;
Did you understand ?
Is something like an automatic batch.bat file - «md aa» => «move aa* aa\»; but makes everything automatically after I specify that I want to use the two inital characters of files' name.
I do not need a GUI, command-line is enough.
Can you help me.
A big thank you in advance
Regards.
asgarcymedAsked:
Who is Participating?
 
BrianGEFF719Commented:
I'm very sorry about all this. I finally got to a computer with WSH and I fixed the code and it is now working 100%.
Good Luck.

Brian


dim basePath
basePath = "c:\test"


 if right(basePath,1) <> "\" then basePath = basePath & "\"
  Dim objFileScripting, objFolder
  Dim filename, filecollection, strDirectoryPath, strUrlPath
  dim destFolder
  Set objFileScripting = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileScripting.GetFolder( basePath )
  Set filecollection = objFolder.Files
  For Each filename In filecollection
     tFile = fileName
     while instr(tFile,"\")
      tFile = right(tFile , len(tFile) - instr(tFile,"\"))
     wend

     destFolder = basePath & left(tFile,2)
     
     if objFileScripting.folderExists(destFolder) = false then
        msgbox destFolder
          objFileScripting.CreateFolder ( destFolder )
     end if
     objFileScripting.MoveFile basePath & tFile,destFolder & "\" & tFIle
  Next
0
 
BrianGEFF719Commented:
Try this code. I did not test it but it should be correct.

dim basePath
basePath = "c:\test"


  basePath = iif( right(basePath,1) <> "\", basePath & "\", basePath )
  Dim objFileScripting, objFolder
  Dim filename, filecollection, strDirectoryPath, strUrlPath
  dim destFolder
  Set objFileScripting = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileScripting.GetFolder( iif(right(basePath,1) <> "\",basePath & "\",basePath) )
  Set filecollection = objFolder.Files
  For Each filename In filecollection
        destFolder = basePath & left(fileName,2) & "\"
      if objFileScript.folderExists(destFolder) = false then
            objFileScripting.CreateFolder destFolder
      end if
      objFileScripting.MoveFile basePath & filename, destFolder & fileName
  Next
0
 
BrianGEFF719Commented:
its VBScript btw.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
asgarcymedAuthor Commented:
I replaced “iif” for “if”, but I still get an error – «Line: 5; Char: 14; Error: Syntax error; Code: 800A03EA; Source: Microsoft VBScript compilation error». Can you correct this ?
Thanks.
Regards.
0
 
BrianGEFF719Commented:
try this:

dim basePath
basePath = "c:\test"


  if right(basePath,1) <> "\" then basePath = basePath & "\"
  Dim objFileScripting, objFolder
  Dim filename, filecollection, strDirectoryPath, strUrlPath
  dim destFolder
  Set objFileScripting = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileScripting.GetFolder( iif(right(basePath,1) <> "\",basePath & "\",basePath) )
  Set filecollection = objFolder.Files
  For Each filename In filecollection
       destFolder = basePath & left(fileName,2) & "\"
     if objFileScript.folderExists(destFolder) = false then
          objFileScripting.CreateFolder destFolder
     end if
     objFileScripting.MoveFile basePath & filename, destFolder & fileName
  Next
0
 
BrianGEFF719Commented:
And IIF() is the conditional If statment. Its similiar to the () ?: statment in C++


Brian
0
 
asgarcymedAuthor Commented:
When I use this second VBS with the "iif" (original - exactly what you posted), I get the error - «Line: 10; Char: 3; Error: Type mismarch: "iif"; Code: 800A000D; Source: Microsoft VBScript runtime error».

If I replaced “iif” for “if”, I get the error - «Line: 10; Char: 47; Error: Syntax error; Code: 800A03EA; Source: Microsoft VBScript compilation error».

What do you say about this ?
Thanks.
Regards.
0
 
BrianGEFF719Commented:
I say use the second version I posted using regular if statments.


Brian
0
 
BrianGEFF719Commented:
dim basePath
basePath = "c:\test"


  if right(basePath,1) <> "\" then basePath = basePath & "\"
  Dim objFileScripting, objFolder
  Dim filename, filecollection, strDirectoryPath, strUrlPath
  dim destFolder
  Set objFileScripting = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileScripting.GetFolder( iif(right(basePath,1) <> "\",basePath & "\",basePath) )
  Set filecollection = objFolder.Files
  For Each filename In filecollection
       destFolder = basePath & left(fileName,2) & "\"
     if objFileScript.folderExists(destFolder) = false then
          objFileScripting.CreateFolder destFolder
     end if
     objFileScripting.MoveFile basePath & filename, destFolder & fileName
  Next
0
 
asgarcymedAuthor Commented:
When I use :

 dim basePath
basePath = "c:\test"


  if right(basePath,1) <> "\" then basePath = basePath & "\"
  Dim objFileScripting, objFolder
  Dim filename, filecollection, strDirectoryPath, strUrlPath
  dim destFolder
  Set objFileScripting = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileScripting.GetFolder( iif(right(basePath,1) <> "\",basePath & "\",basePath) )
  Set filecollection = objFolder.Files
  For Each filename In filecollection
       destFolder = basePath & left(fileName,2) & "\"
     if objFileScript.folderExists(destFolder) = false then
          objFileScripting.CreateFolder destFolder
     end if
     objFileScripting.MoveFile basePath & filename, destFolder & fileName
  Next

I get the error - «Line: 10; Char: 3; Error: Type mismarch: "iif"; Code: 800A000D; Source: Microsoft VBScript runtime error».



When I use :

 dim basePath
basePath = "c:\test"


  if right(basePath,1) <> "\" then basePath = basePath & "\"
  Dim objFileScripting, objFolder
  Dim filename, filecollection, strDirectoryPath, strUrlPath
  dim destFolder
  Set objFileScripting = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileScripting.GetFolder( if(right(basePath,1) <> "\",basePath & "\",basePath) )
  Set filecollection = objFolder.Files
  For Each filename In filecollection
       destFolder = basePath & left(fileName,2) & "\"
     if objFileScript.folderExists(destFolder) = false then
          objFileScripting.CreateFolder destFolder
     end if
     objFileScripting.MoveFile basePath & filename, destFolder & fileName
  Next

 I get the error - «Line: 10; Char: 47; Error: Syntax error; Code: 800A03EA; Source: Microsoft VBScript compilation error».

Forgive my ignorance - I am a newbie... I am now beginning to learn VBS. Please be patient to help me.
Thanks.
Regards.
0
 
BrianGEFF719Commented:
Sorry, try this instead.


  if right(basePath,1) <> "\" then basePath = basePath & "\"
  Dim objFileScripting, objFolder
  Dim filename, filecollection, strDirectoryPath, strUrlPath
  dim destFolder
  Set objFileScripting = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileScripting.GetFolder( basePath )
  Set filecollection = objFolder.Files
  For Each filename In filecollection
       destFolder = basePath & left(fileName,2) & "\"
     if objFileScript.folderExists(destFolder) = false then
          objFileScripting.CreateFolder destFolder
     end if
     objFileScripting.MoveFile basePath & filename, destFolder & fileName
  Next
0
 
asgarcymedAuthor Commented:
Now I get the error - «Line: 14; Char: 6; Error: Object required: "objFileScript"; Code: 800A01A8; Source: Microsoft VBScript runtime error».
Thanks.
Regards.
0
 
BrianGEFF719Commented:
Again sorry:


  if right(basePath,1) <> "\" then basePath = basePath & "\"
  Dim objFileScripting, objFolder
  Dim filename, filecollection, strDirectoryPath, strUrlPath
  dim destFolder
  Set objFileScripting = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileScripting.GetFolder( basePath )
  Set filecollection = objFolder.Files
  For Each filename In filecollection
       destFolder = basePath & left(fileName,2) & "\"
     if objFileScripting.folderExists(destFolder) = false then
          objFileScripting.CreateFolder destFolder
     end if
     objFileScripting.MoveFile basePath & filename, destFolder & fileName
  Next
0
 
asgarcymedAuthor Commented:
Now I get the error - «Line: 15; Char: 11; Error: bad file name or number; Code: 800A0034; Source: Microsoft VBScript runtime error».
Thanks.
Regards.
0
 
BrianGEFF719Commented:
try this, sorry for all this confusion I dont have WSH installed on this computer so i'm kidna shooting in the dark right now.

 if right(basePath,1) <> "\" then basePath = basePath & "\"
  Dim objFileScripting, objFolder
  Dim filename, filecollection, strDirectoryPath, strUrlPath
  dim destFolder
  Set objFileScripting = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileScripting.GetFolder( basePath )
  Set filecollection = objFolder.Files
  For Each filename In filecollection
       destFolder = basePath & left(fileName,2) & "\"
     if objFileScripting.folderExists(left(destFolder,len(destFolder) - 1)) = false then
          objFileScripting.CreateFolder destFolder
     end if
     objFileScripting.MoveFile basePath & filename, destFolder & fileName
  Next
0
 
asgarcymedAuthor Commented:
The error is the same - «Line: 15; Char: 11; Error: bad file name or number; Code: 800A0034; Source: Microsoft VBScript runtime error».
Thanks.
Regards.
0
 
BrianGEFF719Commented:
you might want to remove the line "msgbox destFolder", I had that in there just for testing.
0
 
asgarcymedAuthor Commented:
Thank you a lot !!!! Now is perfect ;)
Regards.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.