Mrrrr
AdMiN
 Inregistrat: acum 18 ani
Postari: 2273
|
|
The following VBS script, if used with a keyboard shortcut, will copy the currently selected files names to a text file created in the active Windows Explorer folder.
Note:
The folder must be the first one on the taskbar, if multiple folders are open at the same time.
You can use a simple AHK script to assign a keyboard shortcut to the VBS file, as it is a more reliable method than creating a shortcut to the VBS file and setting a shortcut for it.
AHK simple keyboard shortcut to VBS file:
^p:: ; CTRL+P Hotkey
Run, "wscript.exe" "FULL PATH TO YOUR VBS SCRIPT\Copy selected files names to clipboard.vbs"
return |
VBS script - saved as Copy selected files names to clipboard.vbs
Note: You must SELECT THE FILES FROM LAST TO FIRST, otherwise the last file name will appear first in s.txt file
Option Explicit
Dim msgA, msgB
msgA = MsgBox("In order to get PROPER NAMING ORDER:" & vbCrLf & vbCrLf & _
" 1. CLICK ON THE LAST FILE (last name in the list)" & vbCrLf & _
" 2. PRESS SHIFT THEN CLICK ON THE FIRST FILE (first name in the list)", vbOKCancel, "GET PROPER NAMES")
If msgA = vbCancel Then
WScript.Quit
End if
Dim objShell, objExplorer, objWindow, objSelectedItems, objItem
Set objShell = CreateObject("Shell.Application")
Set objExplorer = Nothing
' Find the active Explorer window
For Each objWindow In objShell.Windows
If InStr(1, objWindow.FullName, "explorer.exe", vbTextCompare) > 0 Then
Set objExplorer = objWindow
Exit For
End If
Next
' Check if an active Explorer window was found
If objExplorer Is Nothing Then
MsgBox "No active Explorer window found. Please open a folder and select a file.", vbExclamation, "Error"
WScript.Quit
End If
' Decode the folder path from URL to standard file path
Dim folderPath
folderPath = objExplorer.LocationURL
folderPath = Replace(folderPath, "file:///", "")
folderPath = Replace(folderPath, "/", "\")
folderPath = Replace(folderPath, "%20", " ")
' Troubleshoot if you get error "No items selected. Please select one or more files
' If the result of the below MsgBox is one of you open folder in Windows Explorer, navigate from that precise window to your desired folder, then try keyboard shortcut again
' or close all Windows Explorer windows and start fresh
msgB = MsgBox("The path of the folder is:" & vbCrLf & folderPath & vbCrLf & vbCrLf & _
"IF THIS PATH IS INCORRECT, before you click the Cancel button:" & vbCrLf & _
" - check what path it is, as it corresponds to another window you have open in Windows Explorer at the moment" & vbCrLf & _
" - copy the path of your desired folder to that specific window" & vbCrLf & _
" - now click the Cancel button and run this code again and the path will be the correct one" & vbCrLf & vbCrLf & _
"NOTE: this happens because VBS can't exactly detect which window is considered by Windows Explorer as 1st", vbOKCancel, "CHECK PATH")
If msgB = vbCancel Then
Set objShell = Nothing
Set objExplorer = Nothing
folderPath = ""
WScript.Quit
End if
' Get the selected items in the active Explorer window
Set objSelectedItems = objExplorer.Document.SelectedItems
' Check if any items are selected
If objSelectedItems.Count = 0 Then
MsgBox "No items selected. Please select one or more files.", vbExclamation, "ERROR"
WScript.Quit
End If
' Collect the names of the selected files (without extensions)
Dim fileNames, itemName
fileNames = ""
For Each objItem In objSelectedItems
itemName = objItem.Name
' Remove the last 4 characters to exclude the extension
If Len(itemName) > 4 Then
itemName = Left(itemName, Len(itemName) - 4)
End If
fileNames = fileNames & itemName & vbCrLf
Next
' Remove the trailing newline character
If Len(fileNames) > 0 Then
fileNames = Left(fileNames, Len(fileNames) - 2)
End If
' Write the collected names to a text file in the active folder
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(folderPath & "\s.txt", True)
objFile.Write fileNames
objFile.Close
objShell.ShellExecute """" & folderPath & "\s.txt" & """"
MsgBox "File names written to s.txt in the source folder and the s.txt file was opened so you can check proper order of names." & vbCrLf & vbCrLf & _
"NOTE: If no file is created, it means the selected folder was not detected properly." & vbCrLf & _
"Run the script again, see which folder/window is considered as selected by Windows Explorer, copy the path from your desired folder to that window's path field and hit enter, then run the script again. Sorry for the inconvenience.", vbInformation, "EUREKA"
' Copy to clipboard did not work - clipboard paste was empty (all worked until this step) - didn't test more to try to fix it
'Dim objClipboard
'Set objClipboard = CreateObject("HTMLFile")
'objClipboard.ParentWindow.ClipboardData.SetData "Text", fileNames
'MsgBox "File names copied to clipboard.", vbInformation, "Success" |
_______________________________________
|
|
