ddantes
asked on
Running a VBA script in subfolders
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(Li nkPath & "\" & 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
'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(Li
If InStr(1, oShtCut.TargetPath, ".wps") > 0 Then
oShtCut.TargetPath = Replace(oShtCut.TargetPath
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
Typo, change:
Sub UndateLinks(oFolder As Shell32.Folder)
to:
Sub UpdateLinks(oFolder As Shell32.Folder)
~bp
Sub UndateLinks(oFolder As Shell32.Folder)
to:
Sub UpdateLinks(oFolder As Shell32.Folder)
~bp
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Yes! Thanks for your expertise.
Welcome.
~bp
~bp
Open in new window
~bp