Mrrrr
AdMiN
 Inregistrat: acum 18 ani
Postari: 2251
|
|
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
MsgBox "I hope you selected the files last to first," & VbCrLf & _
"otherwise last will be first"
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
MsgBox folderPath
' 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
MsgBox "File names written to s.txt in the folder: " & folderPath, vbInformation, "Success"
' 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" |
_______________________________________
|
|
