JuniperGreen
Member
I have been putting together a script to move files from one folder to another while renaming them with random elements in the file name. As this has involved using a series of consecutive input boxes it made me wonder if it were possible to create a single multi-input dialogue or message box using vbscript. I couldn't find anything to show if this was possible and before I do anything further with the script I was wondering if anyone knew if multi-input is possible. I have attached the script which is quite rough with no error checking as yet but it does what I want it to do. I would appreciate anything on multi-input.
Thank you
Thank you
Code:
Dim intMax, k, m, intValue, strChar, strName, strRanDigitsYesNo, intValue2, intMax2, intCount
' Specify the range of characters to use.
Const Chars = "abcdefghijklmnopqrstuvwxyz_123456789"
' Specify the affix range of numbers to use.
Const Chars2 = "123456789"
'Specify Files Source Folder
strSourceFolder = InputBox((chr(13))&(chr(13))&"Enter Source Folder Full Path Ending With A Backslash" ,"Data Input")
' Specify length of random section
intMax = InputBox((chr(13))&(chr(13))&"Enter Number Of Characters For Random Section"&(chr(13))&(chr(13))& "If Random Section Not Required, Hit Cancel","Data Input")
strFileNameToMatch = "txt"
strFileTextTag = ""
strFileTextTag = InputBox((chr(13))&"Add Text Tag" &(chr(13))&(chr(13))&"If No Tag Hit Cancel","Data Input")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strSourceFolder)
intCount = InputBox((chr(13))&(chr(13))&"Start Prefix Numbering From:","Data Input")
strRanDigitsYesNo = InputBox((chr(13))&"If Affix Required Enter Yes (Case Sensitive)" &(chr(13))&(chr(13))&"If Affix Not Required Hit Cancel"&(chr(13))&(chr(13))&"(Affix Holds 6 Random Numbers)","Data Input")
strDestinationFolder = InputBox((chr(13))&(chr(13))&"Enter Target Folder Full Path Ending With A Backslash" ,"Data Input")
For Each objFile In objFolder.Files
strFileName = objFSO.GetFileName(objFile)
If LCase(right(strFileName, 3)) = strFileNameToMatch Then
' If the file ext is longer than 3 characters change the number above as appropriate
Randomize()
k = ""
strName = ""
For k = 1 To intMax
' Original = Retrieve random digit between 0 and 25 (26 possible characters)
' This = Retrieve random digit between 0 and 35 (36 possible characters)
intValue = Fix(36 * Rnd())
' Convert to character in allowed list
strChar = Mid(Chars, intValue + 1, 1)
' Build strName.
strName = strName & strChar
Next
'wscript.echo strName
If strFileTextTag = "" then
strNewFileName = "0"&intCount&"_"&strFileTextTag & strName&".txt"
Else
strNewFileName = "0"&intCount&"_"&strFileTextTag&"_"& strName&".txt"
End if
intMax2 = "6"
Randomize()
strDigChar = ""
strDigName = ""
m = ""
For m = 1 To intMax2
' Retrieve random digit between 0 and 9 (10 possible characters)
intValue2 = Fix(9 * Rnd())
' Convert to digit in allowed digit list
strDigChar = Mid(Chars2, intValue2 + 1, 1)
' Build the name.
strDigName = strDigName & strDigChar
Next
trim(strNewFileName)
length = len(strNewFileName)
'wscript.echo length
pos = length-4
strNewFileName = left(strNewFileName,pos)
if strRanDigitsYesNo = "Yes" then
strNewFileName = strNewFileName&"_"&strDigName&".txt"
else
strNewFileName = strNewFileName&".txt"
end if
objFSO.MoveFile objFile.Path, strDestinationFolder & strNewFileName
intCount = intCount + 1
End If
strDigitName = ""
Next