Solved

Running a VBA script in subfolders

Posted on 2013-01-05
7
528 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 51

Expert Comment

by:Bill Prew
Comment Utility
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
Comment Utility
script errorThank you.  I got an error (see image please).
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Typo, change:

Sub UndateLinks(oFolder As Shell32.Folder)

to:

Sub UpdateLinks(oFolder As Shell32.Folder)

~bp
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 

Author Comment

by:ddantes
Comment Utility
Compile errorOK, I think we're getting closer.  Please see image.
0
 
LVL 51

Accepted Solution

by:
Bill Prew earned 500 total points
Comment Utility
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
Comment Utility
Yes!   Thanks for your expertise.
0
 
LVL 51

Expert Comment

by:Bill Prew
Comment Utility
Welcome.

~bp
0

Featured Post

Get up to 2TB FREE CLOUD per backup license!

An exclusive Black Friday offer just for Expert Exchange audience! Buy any of our top-rated backup solutions & get up to 2TB free cloud per system! Perform local & cloud backup in the same step, and restore instantly—anytime, anywhere. Grab this deal now before it disappears!

Join & Write a Comment

Today, still in the boom of Apple, PC's and products, nearly 50% of the computer users use Windows as graphical operating systems. If you are among those users who love windows, but are grappling to keep the system's hard drive optimized, then you s…
When you start your Windows 10 PC and got an "Operating system not found" error or just saw  "Auto repair for startup". After a while, you have entered a loop for Auto repair which does not fix anything and you will be in a  panic as all your work w…
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 basic overview of Windows Live Photo Gallery and show you various editing filters and touches to photos you can apply. This will be demonstrated using Windows Live Photo Gallery on Windows 7 operating system.

771 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now