removing a space from a text string and merging 2 scripts into one 1

[kiwieur]

Hi,
I have very little knowledge when it comes to vbscript so I was wondering if someone out there could possibley help me with this issue. Please bear with we as explaining the issue will be quite lengthy

When we create a product design in our system is is always 6 numeric digits in length i.e. 123456, then when we place production orders the order number is in the format of

Product design number then a "/" then the cycle then another "/" then a 0 or 1. the cycle part can be either 1 or 2 digits i.e. A thru to Z and then it continues as AA,AB and so on, if the cycle is a single digit then it is preceded with a space therefore the production number end up in one of 2 formats

123456/ A/0
123456/AA/0

but the production order is always 11 digits in length we then create a PDF containing information required by production which is placed on a network drive, the filename of the PDF is constructed as follows.

"productionOrder" & PO Number & ".pdf" therefore a finished filename would look like so

productionOrder123456/ A/0.pdf or productionOrder123456/AA/0.pdf then because having the forward slash in could create problems they are changed to be an underscore therefore the filename changes to

productionOrder123456_ A_0.pdf or productionOrder123456_AA_0.pdf. We then had an issue that when the filename was created the space in a single alpha cycle was omitted thus creating a PDF with the following filename

productionOrder123456_A_0.pdf

we now had 2 different length filnames if it was a single cycle then the filename length was 29 characters, if it was a double cycle the filename was 30 characters and it was important that the filename was always 30 characters so a person who is no longer with the company wrote some vbscript to change the first single unscore to be a double underscore if the filename was only 29 characters using the following code

'SFL Rename Files
' Please change the path below.....


Dim sInputFolder
Dim oFs: Set oFs = CreateObject("Scripting.FileSystemObject")
	Main()
Set oFs = Nothing

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main()
	GetArguments()
	
	RenameFiles(sInputFolder)
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub GetArguments()

'Dim oArgs: Set oArgs = WScript.Arguments

'	If oArgs.Count <> 1 Then
'		WScript.Echo(INVALID_ARG_ERR)
'		WScript.Quit(INVALID_ARG_RET)
'	End If
'##################Change HERE#######################
	sInputFolder = "D:\Users\POliver\Desktop\JobCards2"
'####################################################
'	Set oArgs = Nothing

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RenameFiles(ByVal psFolderPath)

Dim iCnt
Dim oFolder
Dim oFile
	If oFs.FolderExists(psFolderPath) Then
		Set oFolder = oFs.GetFolder(psFolderPath)
		For Each oFile In oFolder.Files
			'### *** ### CHANGE THIS CODE TO CHECK FOR FILES THAT NEED TO BE RENAMED
			If Not InStr(7, oFile.Name,"__",1) > 0 and len(oFile.Name) = 29 Then
				'WScript.Echo(oFile.Path)
				RenameFile(oFile.Path)
			End If
		Next
	Else
		WScript.Echo(Replace(FOLDER_MISSING_ERR, "$FolderName", psFolderPath))
		WScript.Quit(FOLDER_MISSING_RET)
	End If

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RenameFile(ByVal psFileName)

Dim aTemp
Dim sFilePath, _
	sFileName, _
	sFileName_Target

	aTemp = Split(psFileName, "\")
	sFileName = aTemp(UBound(aTemp))

	'### *** ### CHANGE THIS CODE TO END UP WITH THE TARGET FILENAME THAT YOU WANT
'WScript.Echo(sFileName)
'WScript.Echo(mid(sFileName,7,1))
	sFileName_Target = mid(sFileName,1,21)&Replace(mid(sFileName,22,1), "_", "__")&mid(sFileName,23,7)
'WScript.Echo(sFileName_Target)
	
	sFilePath = Left(psFileName, Len(psFileName) - Len(sFileName))

	On Error Resume Next
	If oFs.FileExists(psFileName) Then
		If oFs.FileExists(sFilePath & sFileName_Target) Then
			oFs.DeleteFile(sFilePath & sFileName_Target)
		End If
		
		oFs.MoveFile psFileName, sFilePath & sFileName_Target
	Else
		WScript.Echo(Replace(FILE_MISSING_ERR, "$FileName", psFileName))
		WScript.Quit(FILE_MISSING_RET)
	End If
	On Error Goto 0

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const INVALID_ARG_RET = 1
Const INVALID_ARG_ERR = "You must provide a path of the files you wish to rename."

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const FILE_MISSING_RET = 51
Const FILE_MISSING_ERR = "File Does Not Exist: $FileName"

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const FOLDER_MISSING_RET = 2
Const FOLDER_MISSING_ERR = "Folder Does Not Exist: $FolderPath"

It now appears that for some reason the space is not being ommitted when the file name is produced therefore the filename is now 30 characters long but in a single cycle contains a space but we need it to be an underscore.

Therefore I ahve been trying to find some code that would remove the space before the other code is run so taht we get the correct format, I have manage dto find some and change to to do what we need but am unsure how stable it would be and also I have no idea how to incorporate it into the other code so that it can be run together as a scheduled task which would run every 30 minutes. the code for removing the space is as follows

Option Explicit

Dim StdIn:  Set StdIn = WScript.StdIn
Dim StdOut: Set StdOut = WScript.StdOut
Dim fso:    Set fso = CreateObject("Scripting.FileSystemObject")


'Dim FilesRenamed:   FilesRenamed = 0

Main

Sub Main
   Dim FolderPath
   FolderPath = "D:\Users\POliver\Desktop\JobCards2"

   Dim CurrentFolder
    Set CurrentFolder = fso.GetFolder(FolderPath)
   ProcessFolder CurrentFolder
   'StdOut.WriteLine FilesRenamed & " Files renamed."
End Sub

Sub ProcessFolder (ByVal Folder)
   Dim Files: Set Files = Folder.Files
   Dim File
   For Each File In Files
      If InStr(1,File.Name," ") > 0 Then
         File.Move Replace(File.Path," ","")
         'FilesRenamed = FilesRenamed + 1
      End If
   Next
End Sub
Set fso = Nothing

I am really sorry for the length of the thread but felt it neccessary to try and explain fully the dilema we face at the moment seeing that we can place in the region of 700 orders per day





Regards

Paul

 

[PHV]

Get rid of the 1st script and in yours, replace this:
File.Move Replace(File.Path," ","")
with this:
File.Move Replace(File.Path," ","_")

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[kiwieur]

Hi PHV,

Thank you for your speedy reply, Can I ask do you feel that the code I have adapted is OK ? and does not need any tweaking to make it stable, does it need any error checking in it ?, I am sorry to ask these questions but as I said in my initial thread I am a relative "noob" when it comes to vbscript and this issue is so important that I do not want to create any other issues within our business that may impact upon production.

This script would be run as a scheduled task every 30 minutes and I am not sure how I can tell if the script has finished after looping through all of the files

Regards

Paul

 

[kiwieur]

PHV,

I have tested the script using test folders on my PC however it comes saying the file already exists and I can't work out why. It works fine for just removing the space

Regards

Paul

 

[PHV]

So, use this loop:

For Each File In Files
   If InStr(1,File.Name," ") > 0 Then
      File.Copy Replace(File.Path," ","_"), True
      File.Delete
   End If
Next

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[PHV]

OOps, use this:

For Each File In Files
   If InStr(1,File.Name," ") > 0 Then
      File.Copy Replace(File.Path," ","_"), True
      File.Delete, True
   End If
Next

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[kiwieur]

HI PHV,
I have changed the code and this is what I have now

Option Explicit

Dim StdIn:  Set StdIn = WScript.StdIn
Dim StdOut: Set StdOut = WScript.StdOut
Dim fso:    Set fso = CreateObject("Scripting.FileSystemObject")

Main

Sub Main
   Dim FolderPath
   FolderPath = "D:\Users\POliver\Desktop\JobCards2"

   Dim CurrentFolder
    Set CurrentFolder = fso.GetFolder(FolderPath)
   ProcessFolder CurrentFolder

End Sub

Sub ProcessFolder (ByVal Folder)
   Dim Files: Set Files = Folder.Files
   Dim File
  For Each File In Files
   If InStr(1,File.Name," ") > 0 Then
      File.Copy Replace(File.Path," ","_"), True
      File.Delete, True
   End If
Next 
End Sub
Set fso = Nothing

However when I run it I get the following error message

---------------------------
Windows Script Host
---------------------------
Script: D:\Users\POliver\Desktop\ReplaceSpace.vbs
Line: 25
Char: 7
Error: Wrong number of arguments or invalid property assignment: 'File.Delete'
Code: 800A01C2
Source: Microsoft VBScript runtime error

---------------------------
OK
---------------------------

Can you point me in the right direction please

Regards

Paul

 

[PHV]

OOps, sorry for the typo:
File.Delete True

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[kiwieur]

PHV,

I would like to thank you for all your help on this issue, I have tested the code after correcting the typo and it appears to work great.

It just shows that when you are a relative "noob" like me you try too hard to find a solution and end up creating complex code when a "guru" like your goodself looks at it from another point of view and comes up with a really simple solution

Once again

Thank You

Regards

Paul