?
Solved

VBScript Moving & Rename files

Posted on 2006-05-15
9
Medium Priority
?
191 Views
Last Modified: 2010-04-07
Hi,

I am running into this problem, we will be likely buying this product from Adlibsoftware, it can convert TIF into PDFs, I have been working on the scripts that control the way that converts the files.

I have a following structure:

OrderID(FOLDER)
  ProductName1(FOLDER)
    TIF1
    TIF2
  ProductName2(FOLDER)
    TIF1
    TIF2
  ProductName3(FOLDER)
    TIF1
    TIF2

Is there a way to loop through the OrderID folder and make the file structure like this:

OrderID(FOLDER)
  ProductName1-TIF1
  ProductName1-TIF2
  ProductName2-TIF1
  ProductName2-TIF2
  ProductName3-TIF1
  ProductName3-TIF2


Thx
0
Comment
Question by:mcrmg
  • 5
  • 4
9 Comments
 
LVL 23

Expert Comment

by:basicinstinct
ID: 16689010
This works for me - you run the script in orderID and it will do the rest.

'START CODE
Option Explicit

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

Main

Sub Main
   Dim CurrentFolder: Set CurrentFolder = fso.GetFolder(".")
   CheckFolderNames CurrentFolder
End Sub

Sub CheckFolderNames (ByVal Folder)
   Dim SubFolders: Set SubFolders = Folder.SubFolders
   Dim SubFolder
   Dim File
   Dim n, newName
   For Each SubFolder In SubFolders
      Dim Files: Set Files = SubFolder.Files
      For Each File In Files
      newName = SubFolder.Name + "-" + File.Name
      if instr(file.type, "Tagged Image File") then  'remove this line (and the 'end if') if you want to move all files, not just tif files
            File.Move fso.GetParentFolderName(SubFolder) & "\" & newName
      end if
      Next
   Next
End Sub
'END CODE
0
 
LVL 23

Expert Comment

by:basicinstinct
ID: 16689017
By the way, just copy the code from 'START CODE to 'END CODE, paste it into an empty text file, save it as 'moveTif.vbs' (or whatever) and run it from the root directory (in this case OrderID).
0
 

Author Comment

by:mcrmg
ID: 16692285
hi,


It works great..Is it possible that it could be used in this way?

Instead of using . as current folder, can enterence folder be two levels up?

INPUT
***HERE***
   Company

      OrderID(FOLDER)
            ***current enterence folder***
              ProductName1(FOLDER)
                TIF1
                TIF2
              ProductName2(FOLDER)
                TIF1
                TIF2
              ProductName3(FOLDER)
                TIF1
                TIF2


I am sorry that I shouldve mentioned it....thx
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 23

Expert Comment

by:basicinstinct
ID: 16694291
Yeah, probably the best idea is just to use an absolute path - then you can run the script from anywhere on the machine's file system.

Instead of using . as current folder use "c:\whatever\Company\OrderID"  So the relevant line will now look like this:

Dim CurrentFolder: Set CurrentFolder = fso.GetFolder("c:\whatever\Company\OrderID")

Does that do the job for you?
0
 

Author Comment

by:mcrmg
ID: 16698373
This is what I did, but does not seem working....


'START CODE
Option Explicit

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

Main

Sub Main
   Dim CurrentFolder: Set CurrentFolder = fso.GetFolder("C:\Input")
   CheckFolderNames CurrentFolder
End Sub

Sub CheckFolderNames (ByVal Folder)
   Dim SubFolders: Set SubFolders = Folder.SubFolders
   Dim SubFolder
   
   Dim SubFolders1: Set SubFolders1 = Folder.SubFolders
   Dim SubFolder1
   
   Dim SubFolders2: Set SubFolders2 = Folder.SubFolders
   Dim SubFolder2
   
   Dim SubFolders3: Set SubFolders3 = Folder.SubFolders
   Dim SubFolder3
           
   Dim File
   Dim n, newName
   For Each SubFolder1 In SubFolders1
               For Each SubFolder2 In SubFolders2
                     For Each SubFolder3 In SubFolders3
               
                           For Each SubFolder In SubFolders
                              Dim Files: Set Files = SubFolder.Files
                              For Each File In Files
                             newName = SubFolder.Name + "-" + File.Name
                             'if instr(file.type, "Tagged Image File") then  'remove this line (and the 'end if') if you want to move all files, not just tif files
                                  File.Move fso.GetParentFolderName(SubFolder) & "\" & newName
                             'end if
                              Next
                              'fso.DeleteFolder SubFolder.Name
                           Next
                           
                  Next
            Next
      Next                          
End Sub
'END CODE
0
 

Author Comment

by:mcrmg
ID: 16702397
okay, it is working now, however, I need to delete those empty folders, it says "path not found"

This line:
fso.DeleteFolder SubFolder2.Name


thx


'START CODE
Option Explicit

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")

Main

Sub Main
   Dim CurrentFolder: Set CurrentFolder = fso.GetFolder("C:\Input")
   CheckFolderNames CurrentFolder
End Sub

Sub CheckFolderNames (ByVal Folder)
   Dim SubFolders: Set SubFolders = Folder.SubFolders
   Dim SubFolder
 
   
   
           
   Dim File
   Dim n, newName
   For Each SubFolder In SubFolders
      Dim SubFolders1: Set SubFolders1 = SubFolder.SubFolders
      Dim SubFolder1
               For Each SubFolder1 In SubFolders1
               Dim SubFolders2: Set SubFolders2 = SubFolder1.SubFolders
               Dim SubFolder2
                     For Each SubFolder2 In SubFolders2
                              Dim Files: Set Files = SubFolder2.Files
                              For Each File In Files
                             newName = SubFolder2.Name + "-" + File.Name
                             'if instr(file.type, "Tagged Image File") then  'remove this line (and the 'end if') if you want to move all files, not just tif files
                                  File.Move fso.GetParentFolderName(SubFolder2) & "\" & newName
                             'end if
                              Next
                              MsgBox SubFolder2.Name
                              fso.DeleteFolder SubFolder2.Name
                  Next
            Next
      Next                          
End Sub
'END CODE
0
 
LVL 23

Accepted Solution

by:
basicinstinct earned 1000 total points
ID: 16714381
How about this then:

'START CODE
Option Explicit
Const NO_HIGHER_THAN = 2 'This value determines the highest folder depth
'(relative to the "CurrentFolder" object) the files can be brought
'(otherwise each time the script runs it will bring the files one level higher than before)
Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim depth: depth = 0
Dim delList()
ReDim delList(0)
Main

Sub Main
   Dim CurrentFolder: Set CurrentFolder = fso.GetFolder("C:\Input")
   CheckFolderNames CurrentFolder
   DeleteFolders delList
End Sub

Sub CheckFolderNames (ByVal Folder)
   Dim SubFolders: Set SubFolders = Folder.SubFolders
   Dim SubFolder
   Dim File
   Dim newName
   depth = depth + 1
   For Each SubFolder In SubFolders
      If depth >= NO_HIGHER_THAN Then
            Dim Files: Set Files = SubFolder.Files
            If Files.Count > 0 Then
                  Dim upper: upper = UBound(delList)
                  If delList(upper) <> "" Then
                        ReDim Preserve delList(upper + 1)
                End If
                delList(UBound(delList)) = SubFolder
            End If
            For Each File In Files
                  newName = SubFolder.Name + "-" + File.Name
              File.Move fso.GetParentFolderName(SubFolder) & "\" & newName
            Next
      End If
      CheckFolderNames SubFolder
   Next
   depth = depth - 1
End Sub

Sub DeleteFolders(byval dirList)
      Dim i
      If IsArray(dirList) Then
            For i = LBound(dirList) to UBound(dirList)
                  If fso.FolderExists(dirList(i)) Then
                        fso.DeleteFolder(dirList(i))
                  End If
            Next
      End If
End Sub
'END CODE
0
 

Author Comment

by:mcrmg
ID: 16714623
Thank you
0
 
LVL 23

Expert Comment

by:basicinstinct
ID: 16715994
Woo hoo!  Got there in the end.
You're welcome.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses
Course of the Month14 days, 15 hours left to enroll

839 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question