Solved

Running a VBA script in subfolders

Posted on 2013-01-05
7
538 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 53

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 53

Expert Comment

by:Bill Prew
ID: 38747835
Typo, change:

Sub UndateLinks(oFolder As Shell32.Folder)

to:

Sub UpdateLinks(oFolder As Shell32.Folder)

~bp
0
Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

 

Author Comment

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

Accepted Solution

by:
Bill Prew earned 500 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 53

Expert Comment

by:Bill Prew
ID: 38747951
Welcome.

~bp
0

Featured Post

Ransomware: The New Cyber Threat & How to Stop It

This infographic explains ransomware, type of malware that blocks access to your files or your systems and holds them hostage until a ransom is paid. It also examines the different types of ransomware and explains what you can do to thwart this sinister online threat.  

Question has a verified solution.

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

By default the complete memory dump option is disabled in windows . If we want to enable the complete memory dump for a diagnostic purpose, we have a solution for it. here we are using the registry method to enable this.
On some Windows 7 (SP1) computers, Windows Update becomes super slow even the computer is reasonably fast.  There's one solution that seemed to have worked well for me (after trying a few other suggested solutions).
This Micro Tutorial will teach you how to the overview of Microsoft Security Essentials. This is a free anti-virus software that guards your PC against viruses, spyware, worms, and other malicious software. This will be demonstrated using Windows…
This Micro Tutorial will teach you how to change your appearance and customize your Windows 7 interface to your unique preference. This will be demonstrated using Windows 7 operating system.

837 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