Solved

Running a VBA script in subfolders

Posted on 2013-01-05
7
546 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
7 Comments
 
LVL 55

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 55

Expert Comment

by:Bill Prew
ID: 38747835
Typo, change:

Sub UndateLinks(oFolder As Shell32.Folder)

to:

Sub UpdateLinks(oFolder As Shell32.Folder)

~bp
0
Migrating Your Company's PCs

To keep pace with competitors, businesses must keep employees productive, and that means providing them with the latest technology. This document provides the tips and tricks you need to help you migrate an outdated PC fleet to new desktops, laptops, and tablets.

 

Author Comment

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

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 55

Expert Comment

by:Bill Prew
ID: 38747951
Welcome.

~bp
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This Micro Tutorial will go in depth within Systems and Security in Windows 7 and will go into detail regarding Action Center, Windows Firewall, System, etc. This will be demonstrated using Windows 7 operating system.
The viewer will learn how to successfully create a multiboot device using the SARDU utility on Windows 7. Start the SARDU utility: Change the image directory to wherever you store your ISOs, this will prevent you from having 2 copies of an ISO wit…

688 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