VBSCRIPT : Move Files , Delete File , Create Shortcut to New Location Based on Name: VBScript, File Management

VBSCRIPT : Move Files , Delete File , Create Shortcut to New Location Based on Name

We have workgroup servers/ shares plugged with Powerpoint Presentation (.ppt) files. We need to recurse through the various servers and folders, move (copy/delete) the presentations to a different central folder location, drop a shortcut (based on Filename) in the old location that points to the same File in the new location,
(Once in the main location , we have people who will review the material. The option of having them review in the old location is not possible based on network permissions/security)
Having the shortcuts in place in the old location allows users to find the presentations where they are used to finding them while they are being worked on.

Instant Access to this Solution

Plus...

30 Day FREE access, no risk, no obligation

Collaborate with the world's top tech experts

Unlimited access to our exclusive solution database

Never be left without tech help again

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

"The time we save is the biggest benefit of Experts Exchange to Warner Bros. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange." Mike Kapnisakis, Warner Bros.

"Our team likes having a resource that is more secure than just using Google and most experts using this service really know their stuff. It's nice to look here first versus using Google." Dayna Sellner, Lockheed Martin

"Anytime that I've been stumped with a problem, 9 out of 10 times Experts Exchange has either the accepted solution or an open discussion of the potential solution to the problem." Kenny Red, eBay Inc.

See what Experts Exchange can do for you.

Got a question?

We've got the answer.

Experts Exchange has been collecting answers to technology questions since 1996…3 million and counting! If you have a question, chances are we already have your answer.

Screenshot of Experts Exchange Knowledgebase

Need individual assistance?

Our experts are ready to help.

If you can't find the exact answer you're looking for, ask our exclusive community of 50,000 experts. You’ll get a personalized answer from a trusted professional.

Want to learn from the best?

Read articles from industry experts.

Thousands of free tech tips, tricks, how-to’s and tutorials are available in our peer reviewed articles section. See for yourself how smart our experts are, no login required.

Working on a long term project?

Store your work and research.

Save solutions to your questions, answers you’ve discovered through searching plus helpful articles in your personal knowledgebase for easy future access.

Join the Community

Give a Little. Get a Lot.

Join the community of experts here and help other tech pros by answering question in your area of expertise. You can earn FREE access to all Experts Exchange's premium features and resources.

This might not be perfect yet but take a look and see what you think.

The destination folder is hard coded, you'll need to change that. The extension to process is hard coded.

Right now it prompts for the name of the folder to search for files to move.

Shortcuts are created where the files currently live, after copying the file to the dest folder (overwriting if exists), and then deletes the olf PPT file.

~bp

Dim fso, sPath, sExt, arg, s, DestFolder
 
' Set destination folder, and file extension to copy
sDestFolder = "c:\temp\dest"
sExt = UCase(".PPT")
 
' Create file scripting object
Set fso = CreateObject("Scripting.FileSystemObject")
 
' Prompt for folder to search (recursively) for files to move
sPath = InputBox("Enter path of folder to search:")
If sPath = "" or fso.FolderExists(sPath) = False Then
  MsgBox "Not a valid folder Path.", 64
  WScript.Quit
End If
 
' Start searching for files
s = DoSearch(sPath, sExt)
MsgBox "Files found: " & s
 
Function DoSearch(myPath, myExt)
  Dim mySubdir, oFolder, s1, s2, oFolders, oFiles, oFile
 
  s1 = 0
 
  ' Process all files in this folder
  Set oFolder = fso.GetFolder(myPath)
  Set oFiles = oFolder.Files
  If oFiles.Count > 0 Then
    For Each oFile in oFiles
      If myExt = UCase(Right(oFile.Name, 4)) Then
        DoFile(oFile)
        s1 = s1 + 1
      End If
    Next
  End If
 
  ' Process all folders in this folder
  Set oFolders = oFolder.SubFolders
  If oFolders.Count > 0 Then
    For Each oFolder in oFolders
      mySubdir = oFolder.Path
      s2 = DoSearch(mySubdir, myExt)
      If s2 <> 0 Then
        s1 = s1 + s2
      End If
    Next
  End If
 
  ' Cleanup
  Set oFolders = Nothing
  Set oFiles = Nothing
  Set oFolder = Nothing
  Set oFile = Nothing
 
  ' Return number of files processed
  DoSearch = s1
End Function
 
Function DoFile(myFile)
  ' Copy files to destination Folder
  myFile.Copy sDestFolder & "\" & myFile.Name, True
 
  ' Create shortcut to new file location
  set oShell = WScript.CreateObject("WScript.Shell")
  set oLink = oShell.CreateShortcut(Left(myFile.Path, Len(myFile.Path)-4) & ".lnk")
  oLink.TargetPath = sDestFolder & "\" & myFile.Name
  oLink.WindowStyle = 1
  oLink.Description = "PPT Link"
  oLink.WorkingDirectory = sDestFolder
  oLink.Save
 
  ' Delete current file
  myFile.Delete True
End Function

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:

Select all Open in new window

Question

VBSCRIPT : Move Files , Delete File , Create Shortcut to New Location Based on Name

Subscribe now for full access to Experts Exchange and get

Instant Access to this Solution

VBScript

File Management

Automation

VB Script

Trusted by hundreds of thousands everyday for fast, accurate and reliable tech support.

See what Experts Exchange can do for you.

Got a question?

We've got the answer.

Need individual assistance?

Our experts are ready to help.

Want to learn from the best?

Read articles from industry experts.

Working on a long term project?

Store your work and research.

What Makes Experts Exchange Unique?

Trusted by the world's most respected brands.

Faithfully serving IT professionals since 1996.

Related Solutions

Free Tech Articles

Cloud Class Webinars

Join the Community

Give a Little. Get a Lot.

Answers

3 Ways to Join

The Experts

The Experts

Testimonials

Testimonials

Testimonials

Business Clients

Business Clients

In the Press

In the Press

In the Press