?
Solved

Running a VBA script in subfolders

Posted on 2013-01-05
7
Medium Priority
?
549 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 56

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 56

Expert Comment

by:Bill Prew
ID: 38747835
Typo, change:

Sub UndateLinks(oFolder As Shell32.Folder)

to:

Sub UpdateLinks(oFolder As Shell32.Folder)

~bp
0
Does Your Cloud Backup Use Blockchain Technology?

Blockchain technology has already revolutionized finance thanks to Bitcoin. Now it's disrupting other areas, including the realm of data protection. Learn how blockchain is now being used to authenticate backup files and keep them safe from hackers.

 

Author Comment

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

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 56

Expert Comment

by:Bill Prew
ID: 38747951
Welcome.

~bp
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

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

When you try to extract and to view the contents of a Microsoft Update Standalone Package (MSU) for Windows Vista, you cannot extract the files from the MSU. Here we are going to explain how to extract those hotfix details without using any third pa…
The Windows functions GetTickCount and timeGetTime retrieve the number of milliseconds since the system was started. However, the value is stored in a DWORD, which means that it wraps around to zero every 49.7 days. This article shows how to solve t…
This Micro Tutorial will give you a basic overview of Windows DVD Burner through its features and interface. This will be demonstrated using Windows 7 operating system.
This Micro Tutorial will give you a introduction in two parts how to utilize Windows Live Movie Maker to its maximum capability. This will be demonstrated using Windows Live Movie Maker on Windows 7 operating system.
Suggested Courses

801 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