My code is pulling from a data cells that lists multiple file paths and use semicolons " ; " as the separator. After spliting the data and placing it into an array, I need to remove the semicolons. otherwise my file paths are invalid when they enter the loop.
To clarify: My code works when there is only one file path in the data cell and dies once it hits a cell with multiple paths because of the ";"
ANY HELP would be much appreciated.
My code is the following:
<%
strValue = RS("ATTACHMENTS")
strAryWords = Split(strValue, ";")
' - strAryWords is now an array
For i = 0 to Ubound(strAryWords)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fileObject = fso.getFile(strAryWords(i))
Response.Write "<TH><TR align=left><TD>" & strAryWords(i) &" "& fileObject.Size &" "&"<img src=images/up.gif><BR></TD></TR>"
Set fileObject = Nothing
Set fso = Nothing
Next
%>
If the problem is strValue has a trailing ';', change your code to this:
strValue = RS("ATTACHMENTS")
strAryWords = Split(strValue, ";")
' - strAryWords is now an array
For i = 0 to Ubound(strAryWords)
If strAryWords(i) <> "" Then
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fileObject = fso.getFile(strAryWords(i))
Response.Write "<TH><TR align=left><TD>" & strAryWords(i) &" "& fileObject.Size &" "&"<img src=images/up.gif><BR></TD></TR>"
Set fileObject = Nothing
Set fso = Nothing
End If
NEXT
Related
I would like to have a script that reads a specific folder and extracts the base file names, removes the last two characters and then uses the result to populate the text of an inputbox. The user then selects from the given options and the remainder of the script searches and replaces text in a second folder with the selected text.
Example file names in the initial target folder:
ABFA1
ABFA3
ABFA4
HVA1
HVA3
HVA4
ITALA1
ITALA3
ITALA4
Obviously, once the last 2 characters are removed, I am left with duplicates which I will need to remove.
Here is part of the script I have so far:
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFilePath = objFSO.BuildPath(objFSO.GetAbsolutePathName("."), "\dwgs\logos")
If Not objFSO.FolderExists(strFilePath) Then
wscript.echo("Folder does not exist, script exiting")
wscript.quit
End if
'
Set objFolder = objFSO.GetFolder (strFilePath)
For Each objFile In objFolder.Files
strFile = objFSO.GetBaseName(objFile.Name)
strFile = LEFT(strFile, (LEN(strFile)-2))
' wscript.echo(strFile)
Next
'delete all duplicate files names and add result to dictionary (or array?)
'create an inputbox and present a number of choices populated by the dictionary/array
user1 = InputBox("Select a Logo:"&(chr(13))&(chr(13))&(*array/dict*)), "Logo Replacement Script")
' Set arguments
strFilePath2 = objFSO.BuildPath(objFSO.GetAbsolutePathName("."), "\dwgs")
FindString = "dwgs\logos\"
ReplaceStringWith = "dwgs\logos\"&(user1)
' Find and replace function
I am able to get the base file names with the last 2 characters removed, but I dont know how to weed out the duplicates and then use the result in an inputbox? (I'm imagining text within the inputbox of a number followed by a choice and the user enters the number to signify which option to use)
My first thought was to use an array, but after some reading, it would seem a dictionary approach might be better. Unfortunately, I haven't been able to figure out how to incorporate it into the script.
Any help would be much appreciated.
Updated script incorporating input from Ekkehard:
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFilePath = objFSO.BuildPath(objFSO.GetAbsolutePathName("."), "\dwgs\logos")
'
Function ShowFilesInFolder(strFolderPath)
Set oFolder = objFSO.GetFolder(strFolderPath)
Set oFileCollection = oFolder.Files
For Each oTempFile in oFileCollection
strTemp = strTemp & oTempFile.name
strTemp = LEFT(strTemp, (LEN(strTemp)-6))
Next
ShowFilesInFolder = strTemp
End Function
x = ShowFilesInFolder(strFilePath)
'
Function mkDic(aK, aV)
Dim tmp : Set tmp = CreateObject("Scripting.Dictionary")
Dim i
For i = 0 To UBound(aK)
tmp(aK(i)) = aV(i)
Next
Set mkDic = tmp
End Function
'
Dim a : a = Split (x)
WScript.Echo Join(mkDic(a, a).Keys)
For some reason I cant get the mkDic Function to split the input from the ShowFilesInFolder Function?
Is there an easier way to go about it than what I have come up with?
The VBScript tool for uniqueness is The Dictionary. This demo (cf. here)
Option Explicit
' based on an Array 2 Dictionary function from
' !! https://stackoverflow.com/a/45554988/603855
Function mkDic(aK, aV)
Dim tmp : Set tmp = CreateObject("Scripting.Dictionary")
Dim i
For i = 0 To UBound(aK)
' tmp(aK(i)) = aV(i)
tmp(Mid(aK(i), 1, Len(aK(i)) - 2)) = aV(i)
Next
Set mkDic = tmp
End Function
Dim a : a = Split("ABFA1 ABFA3 ABFA4 HVA1 HVA3 HVA4 ITALA1 ITALA3 ITALA4")
WScript.Echo Join(a)
WScript.Echo Join(mkDic(a, a).Keys), "=>", Join(mkDic(a, a).Items)
output:
cscript 45590698.vbs
ABFA1 ABFA3 ABFA4 HVA1 HVA3 HVA4 ITALA1 ITALA3 ITALA4
ABF HV ITAL => ABFA4 HVA4 ITALA4
shows, how to de-duplicate an array and how to stringify the (unique) keys for concatenating into a prompt.
I managed to get a working script, but couldn't figure out how to do it without using a couple of temporary text files to pass the data on.
I thought I would post the code in case it may be of help to someone.
Const ForReading = 1, ForWriting = 2, ForAppending = 8, N = 0
Set fso = CreateObject("Scripting.FileSystemObject")
strFilePath = fso.BuildPath(fso.GetAbsolutePathName("."), "\dwgs\logos")
If Not fso.FolderExists(strFilePath) Then
wscript.echo("The LOGO Folder Does Not Exist - Exiting Script")
wscript.quit
End if
'
Set f = fso.OpenTextFile("xtempLogos.txt", ForWriting, True)
Set objShell = CreateObject ("Shell.Application")
Set objFolder = objShell.Namespace (strFilePath)
For Each strFileName in objFolder.Items
a = objFolder.GetDetailsOf (strFileName, N)
a = LEFT(a, (LEN(a)-6))
f.Writeline (a)
Next
f.Close
'
Set f = fso.OpenTextFile("xtempLogos.txt", ForReading)
TheFile = f.ReadAll
f.Close
'
Function mkDic(aK, aV)
Dim tmp : Set tmp = CreateObject("Scripting.Dictionary")
Dim i
For i = 0 To UBound(aK)
tmp(aK(i)) = aV(i)
Next
Set mkDic = tmp
End Function
'
Set f = fso.OpenTextFile("xtempLogos.txt", ForWriting, True)
Dim a : a = Split(TheFile,vbcrlf)
a = Join(mkDic(a, a).Keys)
f.Writeline (a)
f.Close
'
Set f = fso.OpenTextFile("xtempLogos2.txt", ForWriting, True)
Set f = fso.OpenTextFile("xtempLogos.txt", ForReading)
theFile = f.ReadAll
number = 1
myArray = Split(theFile)
for i = 0 to Ubound(MyArray)-1
Set f = fso.OpenTextFile("xtempLogos2.txt", ForAppending, True)
If number < 10 then f.Writeline (number) & ".........." & myArray(i)
If number >=10 then f.Writeline (number) & "........." & myArray(i)
f.Writeline ""
Set f = fso.OpenTextFile("xtempLogos.txt", ForReading, True)
number=number+1
Next
f.Close
'
Set f = fso.OpenTextFile("xtempLogos2.txt", ForReading)
TheFile = f.ReadAll
f.Close
'
user1 = InputBox("WHICH LOGO DO YOU WANT TO ADD?"&(chr(13))&(chr(13))&(chr(13))& (theFile), "Add Logo Script", 11)
choice = (user1) - 1
wscript.echo myArray(choice)
'
Set f = fso.GetFile("xtempLogos.txt")
f.Delete
Set f = fso.GetFile("xtempLogos2.txt")
f.Delete
I have made the script FindAndReplace.vbs which simply watches a folder and finds any desired string in the filenames and replaces that string with a desired string.
Now, What I´m trying to create is a VBScript (ConfigureFindAndReplace.vbs) that will easily configure the following 3 things in the FindAndReplace.vbs code:
Browse and select which folder to watch (targetPath)
Which text string to search for in the filenames of the files inside this folder (strFind)
Which string to replace with (strReplace)
I want the script to be user friendly for users with no programming skills.
And I want the main executable script FindAndReplace.vbs to automatically be updated EVERY time the ConfigureFindAndReplace.vbs is run.
To better help you understand here is th
e link to a .zip file containing both of the above mentioned files. This is as far as I can get and I´ve been stuck for 2 days now:
https://www.dropbox.com/s/to3r3epf4ffyedb/StackOverFlow.zip?dl=0
Hope I explained it properly. If not, let me know whatever you need to know.
Thanks in advance:)
And here are the codes from the files:
ConfigureFindAndReplace.vbs:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject ("Shell.Application")
Set objTFolder = objShell.BrowseForFolder (0, "Select Target Folder", (0))
targetPath = objTFolder.Items.Item.Path
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
sScriptDir = oFSO.GetParentFolderName(WScript.ScriptFullName) & "/"
strFind = InputBox("Add string to find.","String to Find", "")
If strFind = "" Then
Wscript.Quit
End If
strReplace = InputBox("Add string to replace with.","Replace with", "")
Dim VarFind
Dim VarReplace
Dim VarPath
VarFind = strFind
VarReplace = strReplace
VarPath = targetPath
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfolderpath:" & VarPath
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfind:" & VarPath
WshShell.Run sScriptDir & "FindAndReplace.vbs /strreplace:" & VarPath
FindAndReplace.vbs:
'Written by Terje Borchgrevink Nuis on 15.12.2014
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim strFind
Dim strReplace
Dim strFolderPath
strFolderPath = WScript.Arguments.Named("strfolderpath")
targetPath = strFolderPath
'Max number of times to replace string
strCount = 999
'Comparison type: 0 = case sensitive, 1 = case insensitive
strCompare = 1
If targetPath = "" Then
Wscript.Quit
End If
strFind = WScript.Arguments.Named("strfind")
If strFind = "" Then
Wscript.Quit
End If
strReplace = WScript.Arguments.Named("strreplace")
Set objFolder = objFSO.GetFolder(targetPath)
fileRename objFolder
Sub fileRename(folder)
Do
Wscript.sleep 10000
'Loop through the files in the folder
For Each objFile In folder.Files
filename = objFile.Name
ext = objFSO.getExtensionName(objFile)
safename = Left(filename, Len(filename) - Len(ext) - 1)
strStart = 1
safename = Replace(safename, strFind,strReplace,strStart,strCount,strCompare)
safename = trim(safename)
On Error Resume Next
'Terminate if filename stop.txt is found
If filename="STOP.txt" Then
result = MsgBox ("Are you sure you want to terminate the following VBScript?" & vbNewLine & vbNewLine & "FindAndReplace.vbs", vbOKCancel+vbSystemModal , "Terminate VBScript")
Select Case result
Case vbOK
WScript.quit
Case vbCancel
MsgBox "FindAndReplace.vbs is still running in the background.",,"Information"
End Select
End If
'Only rename if new name is different to original name
If filename <> safename & "." & ext Then
objFSO.MoveFile objFile.Path, objFile.ParentFolder.Path & "\" & safename & "." & ext
End If
If Err.Number <> 0 Then
WScript.Echo "Error renaming: " & filename.path & "Error: " & Err.Description
Err.Clear
End If
Next
Loop
End Sub
You think you want ConfigureFindAndReplace to change the other script, this is a bad idea.
You don't know it yet, but what you actually want is for FindAndReplace to read those items from a configuration file.
If the config file is well formed and easy to read, then your users can directly update the config file, so you may not even need the ConfigureFindAndReplace script.
How?
Have a text file with 3 lines
Target Folder=c:\DataFolder
String to find=a string
Replace with=Replace a string with this string
Then in FindAndReplace, before doing any work, you open this file and read in the three lines.
Split the lines on the '=' sign. The left half is the setting and the right half is the value.
Math these up to three variables in the script
If configLineLeft = "Target Folder" then REM Each of these should be case insensitive match
REM e.g. lcase(configLineLeft) = lcase("Target Folder")
TargetFolder = configLineRight
else if configLineLeft = "String to find" then
FindString = configLineRight
else if configLineLeft = "Replace with" then
ReplaceString = configLineRight
else
REM REPORT A PROBLEM TO THE USER AND EXIT
EXIT SUB
end if
You'd do the above in a while loop (while not end of file), reading each line and testing to see which setting it is.
As I can't find any VBScript in your .Zip, some general advice. If you want a not-to-be-edited script to do different things
let the script access parameters/arguments and specifying the differences by calling the script with different arguments: cscript FindAndReplace.vbs "c:\some\folder" "param" "arg"
let the script access config data (from a .txt, .ini, .xml, .json, ... file; from a database; from the registry; ...) and use the config script to set these data
use a template/placeholder file to generate (different version of) the script
I would start with the first approach.
After reading your edit:
Instead of calling your script trice with bad args:
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfolderpath:" & VarPath
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfind:" & VarPath
WshShell.Run sScriptDir & "FindAndReplace.vbs /strreplace:" & VarPath
execute it once with proper args:
WshShell.Run sScriptDir & "FindAndReplace.vbs /strfolderpath:" & VarPath & " /strfind:" & VarFind & "/strreplace:" & VarReplace
(untested; you need to check the names and take care of proper quoting; cf here)
I have text files that are approximately 6MB in size. There are some lines that contain the NULL (Chr(0))character that I would like to remove.
I have two methods to do this: using Asc()=0 but this takes approximately 50s to complete, the other method uses InStr (line, Chr(0)) =0 (fast ~ 4sec)but the results remove vital info from the lines which contain the NULL characters.
First line of text file as example:
##MMCIBN.000NULL7NULL076059NULL7653NULL1375686349NULL2528NULL780608NULL10700NULL\NULL_NC_ACT.DIR\CFG_RESET.INI
First method (works but VERY slow)
function normalise (textFile )
Set fso = CreateObject("Scripting.FileSystemObject")
writeTo = fso.BuildPath(tempFolder, saveTo & ("\Output.arc"))
Set objOutFile = fso.CreateTextFile(writeTo)
Set objFile = fso.OpenTextFile(textFile,1)
Do Until objFile.AtEndOfStream
strCharacters = objFile.Read(1)
If Asc(strCharacters) = 0 Then
objOutFile.Write ""
nul = true
Else
if nul = true then
objOutFile.Write(VbLf & strCharacters)
else
objOutFile.Write(strCharacters)
end if
nul = false
End If
Loop
objOutFile.close
end function
The output looks like this:
##MMCIBN.000
7
076059
7653
1375686349
2528
780608
10700
\
_NC_ACT.DIR\CFG_RESET.INI
Second method code:
filename = WScript.Arguments(0)
Set fso = CreateObject("Scripting.FileSystemObject")
sDate = Year(Now()) & Right("0" & Month(now()), 2) & Right("00" & Day(Now()), 2)
file = fso.BuildPath(fso.GetFile(filename).ParentFolder.Path, saveTo & "Output " & sDate & ".arc")
Set objOutFile = fso.CreateTextFile(file)
Set f = fso.OpenTextFile(filename)
Do Until f.AtEndOfStream
line = f.ReadLine
If (InStr(line, Chr(0)) > 0) Then
line = Left(line, InStr(line, Chr(0)) - 1) & Right(line, InStr(line, Chr(0)) + 1)
end if
objOutFile.WriteLine line
Loop
f.Close
but then the output is:
##MMCIBN.000\CFG_RESET.INI
Can someone please guide me how to remove the NULLS quickly without losing information. I have thought to try and use the second method to scan for which line numbers need updating and then feed this to the first method to try and speed things up, but quite honestly I have no idea where to even start doing this!
Thanks in advance...
It looks like the first method is just replacing each NULL with a newline. If that's all you need, you can just do this:
Updated:
OK, sounds like you need to replace each set of NULLs with a newline. Let's try this instead:
strText = fso.OpenTextFile(textFile, 1).ReadAll()
With New RegExp
.Pattern = "\x00+"
.Global = True
strText = .Replace(strText, vbCrLf)
End With
objOutFile.Write strText
Update 2:
I think the Read/ReadAll methods of the TextStream class are having trouble dealing with the mix of text and binary data. Let's use an ADO Stream object to read the data instead.
' Read the "text" file using a Stream object...
Const adTypeText = 2
With CreateObject("ADODB.Stream")
.Type = adTypeText
.Open
.LoadFromFile textFile
.Charset = "us-ascii"
strText = .ReadText()
End With
' Now do our regex replacement...
With New RegExp
.Pattern = "\x00+"
.Global = True
strText = .Replace(strText, vbCrLf)
End With
' Now write using a standard TextStream...
With fso.CreateTextFile(file)
.Write strText
.Close
End With
I tried this method (update2) for reading a MS-Access lock file (Null characters terminated strings in 64 byte records) and the ADODB.Stream didn't want to open an already in use file. So I changed that part to :
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile(Lfile)
z = f.Size
set ts = f.OpenAsTextStream(ForReading, 0) 'TristateFalse
strLog = ts.Read(z)
ts.Close
set f = nothing
' replace 00 with spaces
With New RegExp
.Pattern = "\x00+"
.Global = True
strLog = .Replace(strLog, " ")
End With
' read MS-Access computername and username
for r = 1 to len(strLog) step 64
fnd = trim(mid(strLog,r, 32)) & ", " & trim(mid(strLog,r+32, 32)) & vbCrLf
strRpt = strRpt & fnd
next
Can someone look at the below script and tell me why it's throwing this error subscript out of range error in vbscript ..In the text file there are two entries it writes to the file correctly but then it throws an error while exiting the loop so it never calls the other function..I think it's trying to run 3 times but there are just 2 entries in the text file
The text file is in this format
Format.css Shared
Design.css Shared
Dim strInputPath1
Dim txsInput1,txsOutput
Dim FSO
Dim Filename
Set FSO = CreateObject("Scripting.FileSystemObject")
strOutputPath = "C:\txt3.txt"
Set txsOutput = FSO.CreateTextFile(strOutputPath)
Set re = New RegExp
re.Pattern = "\s+"
re.Global = True
Set f = FSO.OpenTextFile("C:\Users\spadmin\Desktop\Main\combination.txt")
Do Until f.AtEndOfStream
tokens = Split(Trim(re.Replace(f.ReadLine, " ")))
extension = Split(tokens(0),".")
strInputPath1 = "C:\inetpub\wwwroot\Test\files\" & tokens(1) & "\" & extension(1) & "\" & tokens(0)
Set txsInput1 = FSO.OpenTextFile(strInputPath1, 1)
WScript.Echo strInputPath1
txsOutput.Writeline txsInput1.ReadAll
Loop
WScript.Echo "Calling"
txsInput1.Close
txsOutput.Close
f.Close
Call CreateCSSFile()
''''''''''''''''''''''''''''''''''''
' Merge Css Files
''''''''''''''''''''''''''''''''''''
Sub CreateCSSFile()
WScript.Echo "Called"
Dim FilenameCSS
Dim strInputPathCSS
Dim txsInputCSS,txsOutputCSS
Dim FSOCSS
Set FSOCSS = CreateObject("Scripting.FileSystemObject")
strOutputPathCSS = "C:\txt4.txt"
Set txsOutputCSS = FSOCSS.CreateTextFile(strOutputPath)
Set re = New RegExp
re.Pattern = "\s+"
re.Global = True
Set fCSS = FSOCSS.OpenTextFile("C:\Users\spadmin\Desktop\TestingTheWebService\combination.txt")
Do Until fCSS.AtEndOfStream
tokensCSS = Split(Trim(re.Replace(fCSS.ReadLine, " ")))
extensionCSS = Split(tokensCSS(0),".")
strInputPathCSS = "C:\inetpub\wwwroot\EpsShared\c\" & tokensCSS(1) & "\" & extensionCSS(1) & "\" & tokensCSS(0)
Set txsInputCSS = FSOCSS.OpenTextFile(strInputPathCSS, 1)
txsOutputCSS.Writeline txsInputCSS.ReadAll
Loop
fCSS.Close
txsInputCSS.Close
txsOutputCSS.Close
Set FSOCSS = Nothing
End Sub
If your file contains trailing blank lines, applying Split() may return arrays with less than 2 elements. In that case token(1) should throw a 'subscript out of range' error.
You should always check, if Split() workes as expected:
tokens = Split(Trim(re.Replace(f.ReadLine, " ")))
If 1 = UBound(tokens) Then
extension = Split(tokens(0),".")
If 1 = UBound(extension) Then
strInputPath1 = "..." & tokens(1) & "..."
Else
... parse error ...
End If
Else
... parse error or just trailing blank lines? ...
End If
I have a directory full of files that I need to rename. For each file, I need to take the first three characters of the filename and move them to the end of the filename before the extension.
So 003999999.wav would become 999999003.wav.
The scripting language doesn't really matter. It just needs to work in Windows. This seems like it'd be an easy script using vbscript and I'm currently doing some reading, but figured I'd see if someone already has something like this that would work.
Edit - So I think I've found how to do this, except the part on getting the filename characters. Here's what I have.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Directory")
For Each strFile in objFolder.Files
arrNames = Split(strFile.Name, ".")
If arrNames(1) = "mp3" Then
Set objstart = objFSO.Range(0,3)
Set objend = objFSO.Range(4,17)
strNewName = "C:\Directory\" & objend.Text & objstart.Text & ".mp3"
objFSO.MoveFile strFile.Path, strNewName
End If
Next
Try this script. I used simple string functions to manipulate each filename.
'Rename Files
'============
Dim objFSO, objFolder, strFile, intLength, firstThree, restofName, strNewName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Directory")
For Each strFile in objFolder.Files
'Get files by extension
If objFSO.GetExtensionName(strFile.Name) = "mp3" Then
'Use instr to get the location of the "." and subtract 1 for the "."
intLength = InStr(1,strFile.Name,".",1)-1
'Use the Left function to get the first three characters of the filename
firstThree = Left(strFile.Name,3)
'Use the Mid function to get the rest of the filename subtract 3 for the file extension
restofName = Mid(strFile.Name,4,intLength -3)
strNewName = "C:\Directory\" & restofName & firstThree & ".mp3"
objFSO.MoveFile strFile.Path, strNewName
End If
Next
WScript.Echo "Done!"
Instead of the fictional .Range method, use a regular expression:
>> s1 = "003999999.wav"
>> Set r = New RegExp
>> r.Pattern = "(\d{3})(\d+)(\.wav)"
>> s2 = r.Replace(s1, "$2$1$3")
>> WScript.Echo s2
>>
999999003.wav
to cut three digits (\d{3}), the other digits (d+), and the (escaped) dot followed by the extension (wav) from the input string and re-arange the 3 parts in the .Replace.
Simplified version of JP's solution:
Set fso = CreateObject("Scripting.FileSystemObject")
For Each f In fso.GetFolder("C:\Directory").Files
extension = fso.GetExtensionName(f.Name)
If LCase(extension) = "mp3" Then
basename = fso.GetBaseName(f.Name)
f.Name = Mid(basename, 4) & Left(basename, 3) & "." & extension
End If
Next
In batch you'd do it like this:
#echo off
setlocal EnableDelayedExpansion
for %%f in (C:\Directory\*.mp3) do (
set basename=%%~nf
ren "%%~ff" "!basename:~3!!basename:~0,3!%%~xf"
)
endlocal