Mrrrr
AdMiN
 Inregistrat: acum 18 ani
Postari: 2270
|
|
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" |
_______________________________________

|
|