i have a vbscript which connects to db2 and recset gets long varchar 18000 (contains xml message).
The problem is that variable in vbscript has length only 250.
Ok, i have divided recset to array(50) 250 chars each string.
Then when i trying to pass first string from array to file it throws error.
Because in array(0) string there are a lot of quotes. How can i save result to file?
sql = "select message_data from messages where MESSAGE_ID = '5461654648464'"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.ConnectionString = "Provider=ibmdadb2; DSN=TEST; UID=user; PWD=password"
objConnection.Open
Set recset = CreateObject("ADODB.Recordset")
recset.Open sql,objConnection
if recset.EOF then WScript.Echo "No found" else splt recset("message_data") end if
recset.Close
objConnection.Close
function splt (strg)
dim arr(50)
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\jdk1.3\temp\arch"
Set NewFile = fso.CreateTextFile(sFolder&"\file.txt", True)
if len(strg) > 250 then ll = round(len(strg)/250, 0) + 1
for i = 0 to ll
arr(i) = left(right(strg, abs(Cint(len(strg))-250*i)), 250)
txt = arr(i)
NewFile.Write txt
next
NewFile.Close
End function
#Ruslan: Make sure the file exists first (it can be just a blank text file) and I'd suggest you also update your function with
Dim arr(50), fso, sFolder, NewFile, ll, txt, i
and add Option Explicit right at the top of the file as well.
Related
I need to help in converting a Python script to VBScript. I'm trying to load the .cal file as a binary value file and edit a particular value in the file but unfortunately, my environment only supports VBScript.
import argparse
parser = argparse.ArgumentParser(description='Sapix Cal File Sensitivity Adjustment')
parser.add_argument("-calfile", default="test.cal", help="Enter the Calfile name (ex: 09781DK5081.cal")
parser.add_argument("-vtest", default=125, help="New Vtest setting (85-205)")
parser.add_argument("-vref", default=250, help="New Vref setting (250-120)")
args = parser.parse_args()
calfile = args.calfile
vtest = args.vtest
vref = args.vref
print(calfile)
print(vtest)
print(vref)
with open(calfile, "rb") as binary_file:
# Read the whole file at once
data = bytearray(binary_file.read())
# Find Line with VTEST setting
ivteststart = data.find(bytearray('PARALLEL_VOLTAGE_TEST', 'utf-8'))
ivtestend = data.find(b'\n',ivteststart)
# Remove original VTEST line
del data[ivteststart:ivtestend+1]
# Insert New Line with new VTEST
new_vtest = bytearray("PARALLEL_VOLTAGE_TEST %s\n" % (vtest),'utf-8')
data[ivteststart:ivteststart] = new_vtest
# Find Line with VREF setting
ivrefstart = data.find(bytearray('PARALLEL_VOLTAGE_REF', 'utf-8'))
ivrefend = data.find(b'\n',ivrefstart)
# Remove original VREF line
del data[ivrefstart:ivrefend+1]
# Insert New Line with new VREF
new_vref = bytearray("PARALLEL_VOLTAGE_REF %s\n" % (vref),'utf-8')
data[ivrefstart:ivrefstart] = new_vref
# Write new sensitivity settings to cal file
with open(calfile, "wb") as binary_file:
binary_file.write(data)
I was able to make the changes if I load the file as text file but I have no clue how to load the same as Binary value and make the changes
Option Explicit
Dim objFso, objFolder, objFile, objOtF, cd, content
Dim targetDir
targetDir = "C:\Kiosk\UI"
Dim objRegExp
Set objRegExp = New RegExp
objRegExp.Pattern = "\bPARALLEL_VOLTAGE_TEST \d+\b"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(targetDir)
For Each objFile in objFolder.Files
If LCase(Right(objFile.Name, 4)) = ".cal" Then
cd = objFile.Name
Set objOtF = objFso.OpenTextFile(cd, 1)
content = objOtF.ReadAll
objOtF.Close
Set objOtF = objFso.OpenTextFile(cd, 2)
objOtF.Write objRegExp.Replace(content, "PARALLEL_VOLTAGE_TEST 230")
objOtF.Close
Dim objRegExp1
Set objRegExp1 = New RegExp
objRegExp1.Pattern = "\bPARALLEL_VOLTAGE_REF \d+\b"
Set objOtF = objFso.OpenTextFile(cd, 1)
content = objOtF.ReadAll
objOtF.Close
Set objOtF = objFso.OpenTextFile(cd, 2)
objOtF.Write objRegExp1.Replace(content, "PARALLEL_VOLTAGE_REF 190")
objOtF.Close
End If
Next
Take a look at the following post: Read and write binary file in VBscript. You might be able to use ADODB.Stream to read and write binary data. Other approaches are explored also, including reading characters one by one into an array.
Here's the code from that post:
Function readBinary(strPath)
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oFile: Set oFile = oFSO.GetFile(strPath)
If IsNull(oFile) Then MsgBox("File not found: " & strPath) : Exit Function
With oFile.OpenAsTextStream()
readBinary = .Read(oFile.Size)
.Close
End With
End Function
Function writeBinary(strBinary, strPath)
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
' below lines pupose: checks that write access is possible!
Dim oTxtStream
On Error Resume Next
Set oTxtStream = oFSO.createTextFile(strPath)
If Err.number <> 0 Then MsgBox(Err.message) : Exit Function
On Error GoTo 0
Set oTxtStream = Nothing
' end check of write access
With oFSO.createTextFile(strPath)
.Write(strBinary)
.Close
End With
End Function
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
Being I'm a novice at VBS, I'm have a hard time determining why this short script is not returning a column count of 193, One time I'll get the correct count and others I get 0.
Thank you in advance for any and all suggestions.
OldCityCat
Sub VerifyOrders
Dim Results
Dim objFSO, objTextFile, objReadFile, Contents, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile("C:\TestFileWith_194_characters.csv")
Set objTextFile = objFSO.OpenTextFile("C:\TestFileWith_194_characters.csv")
Set objReadFile = objFSO.OpenTextFile("C:\TestFileWith_194_characters.csv",1)
objReadFile.ReadAll
Contents = objReadFile.Column -1
WScript.Echo Contents
If Contents < 194 Then
Results = "No Orders"
Else
Results = "Has Orders"
End if
objReadFile.Close
If Results = "No Orders" Then
Call NoOrders
Else
Call OpenAccess
End If
End Sub
'/ If no orders the send email end script. Else If orders process them
Sub NoOrders
If Results = "No Orders" Then
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
objMail.Display
objMail.Recipients.Add ("gchichester#wilk.us.com")
objMail.Subject = "No Sales Orders to Process"
objMail.Body = "Respect didn't receive any orders for Pine Castle"
objMail.Send
objOutlook.Quit
Set objMail = Nothing
Set objOutlook = Nothing
End If
End Sub
Sub OpenAccess
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Exec("C:\Program Files (x86)\Microsoft Office\Office14\MSACCESS.EXE "&" C:\DropBox\Inflow\DrugSales.accdb /x OnOpen")
WScript.Sleep 60000
WshShell.SendKeys "%{F4}"
End Sub
You are getting 0 when the contents of the text file you're reading from has written a newline character, but nothing else.
From the Microsoft documentation:
After a newline character has been written, but before any other character is written, Column is equal to 1.
Throughly examine the contents of the text file before you attempt to read it in as a text stream.
Of note but not relevant to my answer above: you do not need to declare or set objFile or objTextFile since you are using objReadFile. Suggest removing both the declaration and set operations for both of those variables.
I am trying to pass folder location as variable to a VBScript which has array to consume the location as a parameter. I don't know how to pass it, could some one please help me?
I am trying to pass following location as a variable "C:\New","C:\New1" to the below code, the script is working fine when I directly give the location, but when I tired to pass it as variable it is not working.
Code given below:
Set oParameters = WScript.Arguments
folderlocation = oParameters(0)
Dim folderarray
Dim WshShell, oExec
Dim wow()
Set objShell = CreateObject("WScript.Shell")
Dim oAPI, oBag
Dim fso, folder, file
Dim searchFileName, renameFileTo, day
Dim i
folderarray = Array(folderlocation)
ii = 0
day = WeekDay(Now())
If day = 3 Then
aa = UBound(folderarray)
f = 0
j = 0
x = 0
Y = 0
For i = 0 To aa
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderarray(i))
For Each file In folder.Files
If InStr(file.Name, name) = 1 Then
ii = 1
strid = file.Name
Set re = New RegExp
re.Pattern = ".*myfile.*"
If re.Test( strid ) Then
'msgbox "File exist and the file name is """ & strid & """"
x = x+1
Else
'msgbox "file not found"
End If
Set re = Nothing
End If
Next
If x = 0 Then
ReDim Preserve wow(f)
wow(f) = folderarray(i)
f = f+1
j = j+1
Else
x = 0
End If
Next
End If
If J > 0 Then
ReDim Preserve wow(f-1)
value = Join(wow, ",")
MsgBox "Files not found in the following location(s) :" & value
Else
MsgBox "fine"
End If
To fill an array from a list of arguments you'd call the script like this:
your.vbs "C:\New" "C:\New1"
and fill the array in your.vbs like this:
size = WScript.Arguments.Unnamed.Count - 1
ReDim folderarray(size)
For i = 0 To size
folderarray(i) = WScript.Arguments.Unnamed.Item(i)
Next
If for some reason you must pass the folder list as a single argument you'd call the script like this:
your.vbs "C:\New,C:\New1"
and populate the array in your.vbs like this:
folderarray = Split(WScript.Arguments.Unnamed.Item(0), ",")
I have written the following code, tested it, and it works. I then literally copied and pasted it into a larger program as a sub. I'm getting a Type mismatch on the Split Function now. I copied & pasted it out of the subroutine and into a new file and it works again. Any help on why this is happening would be appreciated.
Dim oFSO
Dim oNew
Dim oExcel
Dim Folder2
Dim oFile
Dim File, Line
Dim f, fc
Dim x, y, e, i, j
Dim objSheet, TFile, TSheet
Dim TextLine
'Calls Excel into session and leaves it running in the background
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = False
oExcel.DisplayAlerts = False
'Opens the selected excel file and then lets the user choose the folder to be updated to it
Set oNew = oExcel.Workbooks.Open(BrowseForFolder("Select Excel File to Update"))
Set oFSO = CreateObject("Scripting.FileSystemObject")
Folder2 = BrowseForFolder("Choose file containing updated CSV's")
Set f = oFSO.GetFolder(Folder2)
Set fc = f.Files
oNew.Activate
'This loops through every file in the folder, compares the name of the file to the names
'of the sheets in the excel file and overwrites the data to on the spreadsheet
For Each oFile In fc
TFile = Left(oFile.Name,InStr(oFile.Name,"-")-1)
For i =1 To oNew.Sheets.Count
j = InStr(oNew.Sheets(i).Name,"-")-1
TSheet = Left(oNew.Sheets(i).Name,j)
if TSheet = TFile Then
oNew.Sheets(i).Activate
set objSheet = oNew.ActiveSheet
objSheet.Name = Left(oFile.Name,InStr(oFile.Name,".")-1)
Set File = oFSO.OpenTextFile(oFile)
x = 1
Do While File.AtEndofStream <> True
Line = File.Readline
TextLine = Split(Line,",")
y = 1
For Each e In TextLine
objSheet.Cells(x, y) = e
y = y+1
Next
x=x+1
Loop
End If
Next
Next
MsgBox "Spreadsheet Updated! New spreadsheet is located in Documents"
' Save merged result as an Excel file in Documents
oNew.SaveAs "SAPDASHBOARD", 51
oNew.Close
' Shut down Excel
oExcel.Quit
Set oExcel = Nothing
Set oNew = Nothing
Set oFile = Nothing
Function BrowseForFolder(title)
Dim shell : Set shell = CreateObject("Shell.Application")
Dim file : Set file = shell.BrowseForFolder(0, title, &H4000,0)
If file is Nothing Then
WScript.Echo "No Folder Selected"
WScript.Quit
End IF
BrowseForFolder = file.self.Path
End Function
I actually figured it out. The problem wasn't this portion of the script, it was the fact that one of the other subroutines in the big program was named Split. So when it tried to run the builtin function "Split" it tried to call the subroutine. That's a mistake I won't be making again