Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Recursively rename and copy a file to several folders

Status
Not open for further replies.
AccessGuruCarl

AccessGuruCarl

Programmer
Joined
Jul 3, 2004
Messages
471
Location
US
Hello,

Is it possible to create a vb script file to copy an .mdb file to every sub-folder from it's root folder if the sub-folder doesn't have a .ldb file and rename the previous file so that it doesn't get over-written.

Example: Server Folder
//K/Access/MDB/

Then in the MDB folder...
There are several folders, named as usernames...
jsmith,amurray,bwright,dwhite, ect...

Each users folder contains 1 copy of an access database.(.mdb file) If the file is open, it creates a .ldb file!

What I'd like to do is have a script file in the MDB folder, so that I can copy the revised .mdb file here, then drag & drop the .mdb file onto the script file to copy it to each users folder, so long as the user's folder doesn't contain a .ldb file, rename previous .mdb file with todays date then copy revised file to users folder.

I've found something similiar to this were they drop a folder of images, and it creates thumbnails in IE of all the images in the folder. So I was hoping this was do-able.

Any Idea's....

Thanks, In Advance!

AccessGuruCarl
Programmers helping programmers
you can't find a better site.
 
Sort by date Sort by votes
1st Problem Solved.....
If your interested in seeing sample see code below.

New problem to solve...
Using Code Below,
How can I keep only 2 or 3 of the most recent files, and delete the rest.

I have an .mdb file ToolingFE.mdb(developers copy)
Which is copied to user folders when ever he makes code or form changes. If the file is not in use, it renames the file to the current date, removing the '/' and then copies the new file into users folder. - The Code Below...

The users folders will have files named as such,
ToolingFE.mdb, 2112007.mdb, 312007.mdb, 3222007.mdb, ect...
where the number format is date without the slashes.

What I need to do is:
Right after renaming the ToolingFE.mdb with the date, I want to delete everything else, but the 3 most recent copies. Then copy the new file in. This way the user can still have a copy of his last version, and the 2 previous.



>>> HOW TO USE THE SCRIPT.
Drag -n- Drop Utility

This utility will update several MS Access files with a new version of the file.
If the file is not in use, it will rename the file to current date adding the .mdb extension, then copy the new file to the users folder.

How to Use: Drop a folder onto the script file.

Where to place script file:
Paste the vb script file 1 folder up from the root folder of the sub-folders you are updating.
See Example Below...

Edit the script file in notepad...
Scroll about half way down until you see the following...
' =============================
' These are the editable strings
strSource = "D:\2\Test.mdb" ' Complete Path for New File to be copied
strMDB = "\Test.mdb" ' Original File to be Renamed with the \
strLDB = "\Test.ldb" ' File to Test For if the db is open with the \ - Prevents renaming the file while it is in use.
' =============================

Example Setup:
Root Folder: C:\Access\MDB\
Paste script file RenameCopyMDB.vbs here. - Drag-n-Drop 'Users' folder onto script!
This script file will update all sub folders in the folder that is dropped onto the script.

Sub-Folders: C:\Access\MDB\Users\JDoe
C:\Access\MDB\Users\AJacks
C:\Access\MDB\Users\ASmith
C:\Access\MDB\Users\FWilliams

Copy code, paste into Notepad.
Save the file as RenameCopyMDB.vbs, or anything you like just besure save as with .vbs extention.

Code: 
Dim intUpdated
Dim intAlreadyUpdated
Dim intFileInUse
Dim intFolderCnt
Dim FSO
Dim WshShell
Dim strInUseMsg 
Dim strUpdatedMsg 

  Set FSO = CreateObject("Scripting.FileSystemObject") 
  Set WshShell = CreateObject("WScript.Shell") 

  intUpdated = 0
  intFileInUse = 0
  intAlreadyUpdated = 0
  intFolderCnt = 0

For Each FolderName In WScript.Arguments.Unnamed 
  On Error Resume Next 
    Set Folder = FSO.GetFolder(FolderName)
' WScript.Echo "The Folder Name is: " & FolderName
    Select Case Err.Number 
      Case 0 
        Rename Folder 
      Case 76 
        WScript.Echo Err.Description, """" & FolderName & """" 
      Case Default 
        WScript.Echo "Error", Err.Number, Err.Description, _ 
                      """" & FolderName & """" 
    End Select 
  On Error GoTo 0 
Next 

If intFileInUse = 1 Then
  strInUseMsg = vbNewLine & "    1 file was in use."
Else
  strInUseMsg = vbNewLine & "    " &intFileInUse & " were in use."
End If

If intAlreadyUpdated > 0 Then
  strUpdatedMsg = vbNewLine & "    " & intAlreadyUpdated & " file(s) already updated."
Else
  strUpdatedMsg = vbNewLine
End If
   
' Display the results 
  WScript.Echo "Finished... " & vbNewLine & "    Updated " & intUpdated & " file(s), out of  "  & intFolderCnt &  strInUseMsg & strUpdatedMsg 

  Set FSO = Nothing 
  Set WshShell = Nothing
 
Sub Rename(Folder) 
  Dim strOldName 
  Dim strNewName 
  Dim strDate
  Dim strSource
  Dim strDestPath
  Dim strMDB
  Dim strLDB
  Dim strLockPath
  Dim v
  Dim strChar
  Dim intStartPos
  Dim intCharPos
  Dim strResult
' =============================
' These are the editable strings
  strSource = "C:\2\Test.mdb"	' Complete Path for New File to be copied
  strMDB = "\Test.mdb"		' Original File to be Renamed with the \
  strLDB = "\Test.ldb"		' File to Test For if the db is open with the \	- Prevents renaming the file while it is in use.
' =============================
  strDate = CStr(Date)
  strChar = "/"
  intStartPos = 1
' Remove the / from date so we can use it rename file.
  intCharPos = InStr(1, strDate, strChar)
  strResult = Mid(strDate, intStartPos, (intCharPos - 1))
  intStartPos = intCharPos + 1
  intCharPos = InStr((intCharPos + 1), strDate, strChar)
  strResult = strResult & Mid(strDate, intStartPos, (intCharPos - intStartPos))
  intStartPos = intCharPos + 1
  strResult = strResult & Mid(strDate, intStartPos, (Len(strDate) - (intStartPos - 1)))

  For Each SubFolder In Folder.SubFolders 
    intFolderCnt = intFolderCnt + 1
    strLockPath = SubFolder & strLDB
      If FSO.FileExists(strLockPath) Then
        intFileInUse = intFileInUse + 1
      Else
        strOldName = SubFolder & strMDB 
        strNewName = strResult & ".mdb"
        On Error Resume Next 
        FSO.GetFile(strOldName).Name = strNewName 
          If Err.Number <> 0 Then 
          '  WScript.Echo Err.Description, "(""" & strNewName & """)" _ 
          '             & " while processing """ & strOldName & """" 
            intAlreadyUpdated = intAlreadyUpdated + 1
          Else
            strDestPath = SubFolder & strMDB
            v = FSO.CopyFile(strSource, strDestPath)
            intUpdated = intUpdated + 1
          End If 
      End If
  strLockPath = ""
  Next 

End Sub

AccessGuruCarl
Programmers helping programmers
you can't find a better site.
 
Upvote 0 Downvote
Just as an aside, the following:

Code: 
  strDate = CStr(Date)
  strChar = "/"
  intStartPos = 1
' Remove the / from date so we can use it rename file.
  intCharPos = InStr(1, strDate, strChar)
  strResult = Mid(strDate, intStartPos, (intCharPos - 1))
  intStartPos = intCharPos + 1
  intCharPos = InStr((intCharPos + 1), strDate, strChar)
  strResult = strResult & Mid(strDate, intStartPos, (intCharPos - intStartPos))
  intStartPos = intCharPos + 1
  strResult = strResult & Mid(strDate, intStartPos, (Len(strDate) - (intStartPos - 1)))

could be replaced with:

[tt]strDate = Replace(CStr(Date),"/","")[/tt]

or even ...

[tt]strDate = Replace(Date,"/","")[/tt]


Hope this helps.

[vampire][bat]
 
Upvote 0 Downvote
Hello earthandfire,

Thanks for the post, I'm aware of the replace function but I couldn't get it to work.

But I think I was trying...
strResult = Replace(strDate),"/","")

I'll give it a try.....

Thanks Again...

AccessGuruCarl
Programmers helping programmers
you can't find a better site.
 
Upvote 0 Downvote
Earthandfire,

Your post was correct, I was trying
strDate = CStr(Date)
strResult = Replace(strDate),"/","")

and it wasn't working, so I reverted to the old Instr and Mid.

Thanks again.... Shorter is better....


AccessGuruCarl
Programmers helping programmers
you can't find a better site.
 
Upvote 0 Downvote

Here is the entire working code for future searches...

See previous post for instructions on useage:

Code: 
Dim intUpdated
Dim intAlreadyUpdated
Dim intFileInUse
Dim intFolderCnt
Dim FSO
Dim WshShell
Dim strInUseMsg 
Dim strUpdatedMsg 

  Set FSO = CreateObject("Scripting.FileSystemObject") 
  Set WshShell = CreateObject("WScript.Shell") 

  intUpdated = 0
  intFileInUse = 0
  intAlreadyUpdated = 0
  intFolderCnt = 0

For Each FolderName In WScript.Arguments.Unnamed 
  On Error Resume Next 
    Set Folder = FSO.GetFolder(FolderName)
' WScript.Echo "For Each Folder Loop in Folder Name is: " & FolderName
    Select Case Err.Number 
      Case 0 
        Rename Folder 
      Case 76 
        WScript.Echo Err.Description, """" & FolderName & """" 
      Case Default 
        WScript.Echo "Error", Err.Number, Err.Description, _ 
                      """" & FolderName & """" 
    End Select 
  On Error GoTo 0 
Next 

If intFileInUse = 1 Then
  strInUseMsg = vbNewLine & "    1 file was in use."
Else
  strInUseMsg = vbNewLine & "    " &intFileInUse & " were in use."
End If

If intAlreadyUpdated > 0 Then
  strUpdatedMsg = vbNewLine & "    " & intAlreadyUpdated & " file(s) already updated."
Else
  strUpdatedMsg = vbNewLine
End If
   
' Display the results 
  WScript.Echo "Finished... " & vbNewLine & "    Updated " & intUpdated & " file(s), out of  "  & intFolderCnt &  strInUseMsg & strUpdatedMsg 

  Set FSO = Nothing 
  Set WshShell = Nothing
 
Sub Rename(Folder) 
  Dim strOldName 
  Dim strNewName 
  Dim strDate
  Dim strSource
  Dim strDestPath
  Dim strMDB
  Dim strLDB
  Dim strLockPath
  Dim v
  Dim ipreserve
  Dim oFolder
  Dim oFile
  Dim rs
  Dim iCount

' =============================
' These are the editable strings
  strSource = "D:\2\Test.mdb"	' Complete Path for New File to be copied
  strMDB = "\Test.mdb"		' Original File to be Renamed with the \
  strLDB = "\Test.ldb"		' File to Test For if the db is open with the \	- Prevents renaming the file while it is in use.
  ipreserve=3    			' # of files to preserve - 3 = (Current file being renamed plus the 2 most recent previous updates)
				' ending result is 4 files in user folder.
' =============================
  Const adVarChar = 200		' File attributes - Used for deleting files
  Const adDate = 7			' File attributes - Used for deleting files
  strDate = CStr(Date)

' Remove the / from date so we can use it rename file.
  strDate = Replace(CStr(Date),"/","")

  For Each SubFolder In Folder.SubFolders 
    intFolderCnt = intFolderCnt + 1
    strLockPath = SubFolder & strLDB
      If FSO.FileExists(strLockPath) Then
        intFileInUse = intFileInUse + 1
      Else
        strOldName = SubFolder & strMDB 
        strNewName = strDate & ".mdb"
        On Error Resume Next 
        FSO.GetFile(strOldName).Name = strNewName 
          If Err.Number <> 0 Then 
          '  WScript.Echo Err.Description, "(""" & strNewName & """)" _ 
          '             & " while processing """ & strOldName & """" 
            intAlreadyUpdated = intAlreadyUpdated + 1
          Else
           ' Delete all the files except 3 most recent
            Set oFolder= SubFolder
            Set rs = CreateObject("ADOR.Recordset")
	With rs.Fields
	    .Append "FilePath",adVarChar,255
	    .Append "DateLastModified",adDate
	End With
	With rs
	    .Open
	   For Each oFile In oFolder.Files
	        .AddNew array("FilePath","DateLastModified"), array(oFile.Path,oFile.DateLastModified)
	        .Update
	    Next
	End With
	iCount=0
	If Not (rs.EOF and rs.BOF) then
	    rs.Sort="DateLastModified desc"
	    rs.MoveFirst
	    Do While Not rs.EOF
	        iCount=iCount+1
	        If iCount>ipreserve Then
	            On Error Resume Next
	            FSO.DeleteFile rs.Fields("FilePath"),True
	            On Error GoTo 0
	        End If
	        rs.MoveNext
	    Loop
	End If
            Set rs=Nothing
            Set oFolder=Nothing
         ' Copy the New File
            strDestPath = SubFolder & strMDB
            v = FSO.CopyFile(strSource, strDestPath)
            intUpdated = intUpdated + 1
          End If 
      End If
  strLockPath = ""
  Next 

End Sub

AccessGuruCarl
Programmers helping programmers
you can't find a better site.
 
Upvote 0 Downvote
For future reference, you might also look at DirReaderObject.

Do one scan of the main directory with SubFolders = False to get a starting Recordset. Filter out any non-folders returned using the IsFolder field (.Filter = "IsFolder = True").

Walk through this Recordset, and for each folder found do another scan returning a second Recordset. Use the necessary sorting, filtering, finding, etc. to do your probing for LDB files, renaming, copying, and deleting.
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Rick_Stanich
  • Locked
  • Question Question
Save xls file to cvs file
Replies
3
Views
771
Rick_Stanich
Rick_Stanich
S
  • Locked
  • Question Question
Need to submit page when clicking a checkbox
Replies
0
Views
624
shbr5413
S
skrall
  • Locked
  • Question Question
script to create shortcuts of several folders in another folder
Replies
1
Views
401
Don Child
Don Child
bdwilcox
  • Locked
  • Question Question
Trying to adapt VBScript to search if machine is in an AD group
Replies
8
Views
2K
SoftwareRT
SoftwareRT
Alexvb6
  • Locked
  • Question Question
Deprecation of VBScript + Classic ASP: How to Ask Microsoft to cancel their planned craziness
Replies
0
Views
891
Alexvb6
Alexvb6

Part and Inventory Search

Sponsor

Back
Top