Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Running a VBA script in subfolders

Posted on 2013-01-05
7
Medium Priority
?
559 Views
Last Modified: 2013-01-05
An Expert has helped me by compiling VBA code to change shortcut links from tartgeting .wps files to targeting .docx files.  However, the script only runs in a specified folder.  I'd appreciate it if someone could edit this script, such that it also runs in subfolders within the specified links path...

'References:
'Microsoft Shell Controls And Automation
'Microsoft Scripting Runtime
'Windows Script Host Object Model

-----------------------------------------------------------------------------------

Sub Redirect_wps_shortcuts()
Dim oWsShell As New WshShell
Dim oShell  As Shell32.Shell
Dim oFolder As Shell32.Folder
Dim oFolderItems As Shell32.FolderItems
Dim FSO As New FileSystemObject
Dim oShtCut As Object
Dim LinkPath As String

LinkPath = "C:\Temp"  'set to your links path

Set oShell = New Shell32.Shell
Set oFolder = oShell.NameSpace(LinkPath)
Set oFolderItems = oFolder.Items

For Each Item In oFolderItems
   If Item.IsLink = True Then
      Set oShtCut = oWsShell.CreateShortcut(LinkPath & "\" & Item.Name & ".lnk")
      If InStr(1, oShtCut.TargetPath, ".wps") > 0 Then
         oShtCut.TargetPath = Replace(oShtCut.TargetPath, ".wps", ".docx")
         oShtCut.Save
         FSO.MoveFile oShtCut.FullName, Replace(oShtCut.FullName, ".wps", ".docx")
      End If
   End If
Next

Set oShtCut = Nothing
Set oFolderItems = Nothing
Set oFolder = Nothing
Set oShell = Nothing
Set FSO = Nothing
End Sub
0
Comment
Question by:ddantes
  • 4
  • 3
7 Comments
 
LVL 59

Expert Comment

by:Bill Prew
ID: 38747819
This should handle the subfolders. Hope it's right, I typically do more scripting in standalone VBS that runs from the command line than in VBA that must be run inside an Office application.

Sub Redirect_wps_shortcuts()
   Dim oWsShell As New WshShell
   Dim oShell  As Shell32.Shell
   Dim FSO As New FileSystemObject
   Dim LinkPath As String
   
   LinkPath = "C:\Temp"  'set to your links path
   
   Set oShell = New Shell32.Shell

   UpdateLinks oShell.NameSpace(LinkPath)

   Set oShell = Nothing
   Set FSO = Nothing
End Sub 

Sub UndateLinks(oFolder As Shell32.Folder)
   Dim oFolderItems As Shell32.FolderItems
   Dim oShtCut As Object

   Set oFolderItems = oFolder.Items
   
   For Each Item In oFolderItems
      If Item.IsLink = True Then
         Set oShtCut = oWsShell.CreateShortcut(LinkPath & "\" & Item.Name & ".lnk")
         If InStr(1, oShtCut.TargetPath, ".wps") > 0 Then
            oShtCut.TargetPath = Replace(oShtCut.TargetPath, ".wps", ".docx")
            oShtCut.Save
            FSO.MoveFile oShtCut.FullName, Replace(oShtCut.FullName, ".wps", ".docx")
         End If
      End If
   Next
   
   For Each oSubFolder In oFolder.SubFolders
      UpdateLinks oSubFolder
   Next
      
   Set oShtCut = Nothing
   Set oFolderItems = Nothing
End Sub

Open in new window

~bp
0
 

Author Comment

by:ddantes
ID: 38747832
script errorThank you.  I got an error (see image please).
0
 
LVL 59

Expert Comment

by:Bill Prew
ID: 38747835
Typo, change:

Sub UndateLinks(oFolder As Shell32.Folder)

to:

Sub UpdateLinks(oFolder As Shell32.Folder)

~bp
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Author Comment

by:ddantes
ID: 38747842
Compile errorOK, I think we're getting closer.  Please see image.
0
 
LVL 59

Accepted Solution

by:
Bill Prew earned 2000 total points
ID: 38747907
I think having to do this from Excel just makes this more complex.  Here's a slightly simpler VBS script that you can run right from the command line as follows and will do the same job:

cscript EE27986084.vbs

' Define base path to update link files in
Const LinkPath = "C:\Temp"

' Create global objects used
Set oShell = WScript.CreateObject("WScript.Shell")
Set oFSO = CreateObject("Scripting.FileSystemObject")

' Call recursive subroutine to locate and update all LNK files
UpdateLinks oFSO.GetFolder(LinkPath)

' Release global objects
Set FSO = Nothing
Set oShell = Nothing


Sub UpdateLinks(oFolder)
   ' Look at each file in this folder
   for Each oFile In oFolder.Files
      ' Only process the LNK files
      If LCase(Right(oFile.Name, 4)) = ".lnk" Then
         ' Access shortcut object from LNK file
         Set oShtCut = oShell.CreateShortcut(oFile.Path)
         ' Does it reference a WPS file
         If InStr(1, oShtCut.TargetPath, ".wps") > 0 Then
            ' Change target file from WPS to DOCX
            Wscript.Echo "Updating [" & oFile.Path & "] -> [" & oShtCut.TargetPath & "]"
            oShtCut.TargetPath = Replace(oShtCut.TargetPath, ".wps", ".docx")
            oShtCut.Save
            ' Rename the target file
            oFSO.MoveFile oShtCut.FullName, Replace(oShtCut.FullName, ".wps", ".docx")
         End If
      End If
   Next
   
   ' Recurively drill into any subfolders to update LNK files there
   For Each oSubFolder In oFolder.SubFolders
      UpdateLinks oSubFolder
   Next
End Sub

Open in new window

~bp
0
 

Author Comment

by:ddantes
ID: 38747913
Yes!   Thanks for your expertise.
0
 
LVL 59

Expert Comment

by:Bill Prew
ID: 38747951
Welcome.

~bp
0

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Question has a verified solution.

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

Possible fixes for Windows 7 and Windows Server 2008 updating problem. Solutions mentioned are from Microsoft themselves. I started a case with them from our Microsoft Silver Partner option to open a case and get direct support from Microsoft. If s…
A quick guide on how to use Group Policy to create a custom power plan and set it active on Windows 7.
In this video, we discuss why the need for additional vertical screen space has become more important in recent years, namely, due to the transition in the marketplace of 4x3 computer screens to 16x9 and 16x10 screens (so-called widescreen format). …
In this Micro Tutorial viewers will learn how to use Boot Corrector from Paragon Rescue Kit Free to identify and fix the boot problems of Windows 7/8/2012R2 etc. As an example is used Windows 2012R2 which lost its active partition flag (often happen…
Suggested Courses

578 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