I have a file written in vbs that wont read a file after about 8MB. I am currently using "Scripting.FileSystemObject". When I test the code, I notice that it runs fine until line ~79500, thats when the "AtEndOfStream" just results in True. I was looking for documentation, but it seems not to exist.
The code is supposed to show duplicate file information and put it in a separate file, which works well enough till around that line.
This is the section of code giving me the problem (it is the second reading function I have in the code):
Set first = fso.OpenTextFile(filePath + firstFileName)
Set secondFile = fso.OpenTextFile(filePath + secondFileName)
count = 0
countInLine = 0
Do Until secondFile.AtEndOfStream
lineMatches = false
lineOfSecond=secondFile.ReadLine
If count > 79440 Then
MsgBox("first line" & first.AtEndOfStream)
End If
Do Until first.AtEndOfStream
lineOfFirst =first.ReadLine
if lineOfSecond = lineOfFirst Then
lineMatches = True
Exit Do
End If
Loop
If Not lineMatches Then
writeFl.Write(count & "second" & lineOfSecond & vbCrLf)
End If
count = count + 1
Loop
Related
I'm using Pervasive 9.2 and would like to somehow convert the vbscript into pervasives RIFL language. I want to execute the code during a Process where the f(x) component is executed to run the code. As far as the Path to the xml data, I'll be using a Macro defining where the source data is and another to save the file as well.
Here is the vbscript code below:
Set xml = CreateObject("Microsoft.XMLDOM")
xml.async = False
count_var = 1
If xml.Load("c:\folder1\test.xml") Then
For Each accounts In xml.SelectNodes("//Accounts")
For Each account In Accounts.SelectNodes("./Account")
If count_var > 1 Then
Set accountEnum = xml.createNode(1, "Account" & count_var, "")
For Each child In Account.childNodes
accountEnum.appendChild(child.cloneNode(TRUE))
Next
Accounts.replaceChild accountEnum, Account
xml.save("c:\folder1\test.xml")
else
Set accountEnum = xml.createNode(1, "Account" & count_var, "")
For Each child In Account.childNodes
accountEnum.appendChild(child.cloneNode(TRUE))
Next
Accounts.replaceChild accountEnum, Account
xml.save("c:\folder1\test.xml")
End If
count_var = count_var + 1
Next
count_var = 1
Next
End If
Set node = Nothing
Set xml = Nothing
ParseXMLFile(filepath)
documentation here
http://docs.pervasive.com/products/integration/di/rifl/wwhelp/wwhimpl/common/html/wwhelp.htm#href=ParseXMLFile_Function.html&single=true
this will return a DOMDocument Object Type
documentation here
http://docs.pervasive.com/products/integration/di/rifl/wwhelp/wwhimpl/common/html/wwhelp.htm#href=DOMDocument_Object_Type.html&single=true
hope this helps
I need to create an excel sheet which contains a visual representation of a bit array. Presently I test the bit value and update the cell contents
For h = 1 To 128
value = Mid(array, h,1)
If value = "1" Then
xl.Application.Sheets("Sheet1").Cells(129 - h,5).value = "X"
Else
xl.Application.Sheets("Sheet1").Cells(129 - h,5).value = ""
End If
Next
If I add a WScript.Sleep 100 before Next then the output result in the excel sheet is correct.
If not, then the X's are in the wrong places.
Initially I thought that it was Excel that was slow, so I tried making a CSV file that I could simply import later, but with the same results: too fast and the X's are in the wrong positions, slow it down and they are correct.
There are around 128 of these 128bit arrays, and if each takes 3 ~ 5 seconds then making this sheet will take forever.
Does anyone know how I can achieve this quickly? I am open to other ideas/solutions (with VBS) outputting the excel file.
Thanks!
Try putting the array into the range in one go, like this
ReDim dat(1 To 128, 1 To 1)
For h = 1 To 128
v = Mid$(arr, h, 1)
dat(129 - h, 1) = IIf(v = "1", "X", "")
Next
xl.Application.Sheets("Sheet1").Cells(1, 5).Resize(128, 1).Value = dat
This worked for me (tested in vbscript rather than vba).
As it uses an array, the "" output as part of an IF is redundant as the array is blank, so it is only necessary to write the X when the bit is 1.
Dim StrArr
Dim xl
Set xl = CreateObject("excel.application")
Set wb = xl.Workbooks.Add
'sample array
StrArr = "1100111011001110110011101100111011001110110011101100111011001110110011101100111011001110110011101100111011001110110011101100111"
Dim X(128, 1 )
For lngrow = 1 To UBound(X)
If Mid(StrArr, lngrow, 1) = "1" Then X(lngrow, 0) = 1
Next
wb.Sheets(1).Cells(1, 5).Resize(UBound(X), 1).Value = X
xl.Visible = True
I made a counter that works when you press the button as the action in VBScript.
my code:
Licznik_ID = Licznik_ID + 1
Dim Stuff, myFSO, WriteStuff, dateStamp
Stuff = "Whatever you want written"
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set WriteStuff = myFSO.OpenTextFile("c:\tmp\yourtextfile.txt", 2, True)
WriteStuff.WriteLine(Licznik_ID)
WriteStuff.Close
SET WriteStuff = NOTHING
SET myFSO = NOTHING
the counter variable named "Licznik_ID"
indicated by the arrow.
It is written to the file "c:\tmp\yourtextfile.txt"
And it works well.
For each time the number increases by one and is replaced and stored in the txt file.
The file contains the number 1 and the increase in the txt file appears the number 2 and so on ...
How now download the data stored with the file "c: \tmp\yourtextfile.txt" back to the variable to use it in such a way that when you start NiceForm or button has been loaded with the contents of txt file into a variable?
Set myFSO = CreateObject("Scripting.FileSystemObject")
Licznik_ID = myFSO.OpenTextFile("C:\tmp\yourtextfile.txt").ReadAll
Licznik_ID = Licznik_ID + 1
myFSO.OpenTextFile("C:\tmp\yourtextfile.txt",2,True).Write(Licznik_ID)
FSO is kinda weird the way it does its file modes sometimes.
edit: If you want to allow this to create the file without errors if it doesn't exist, replace line 2 with this:
If myFSO.FileExists("C:\tmp\yourtextfile.txt") Then
Licznik_ID = myFSO.OpenTextFile("C:\tmp\yourtextfile.txt").ReadAll
End If
If the file doesn't exist, Licznik_ID will be Empty. Empty + 1 = 1 in vbscript.
I have been a longtime lurker of stackoverflow and have now decided to join. I am trying to pull a list of every Functional Location out of SAP using BAPI. When I run this code it returns with an empty table. I dont have very much experiance with BAPI and I am trying to teach myself. Can someone please help with what im missing to make this work.
Thanks,
See code bellow:
Dim sapFunc As New SAPFunctionsOCX.SAPFunctions
Dim objServer = sapFunc.Connection
objServer.Client = "101"
objServer.User = "MyUserName"
objServer.Ticket = "MyKey"
objServer.system = "PEC"
objServer.MessageServer = "MyMessagerServer"
objServer.GroupName = "PUBLIC"
If objServer.logon(0, True) <> True Then
MsgBox("Key Rejected")
Exit Sub
End If
Dim objRfcFunc As SAPFunctionsOCX.Function
objRfcFunc = sapFunc.Add("BAPI_FUNCLOC_GETLIST")
'System.Console.Write(objRfcFunc.Description)
If objRfcFunc.Call = False Then
MsgBox("Error occured - " & objRfcFunc.Exception)
Exit Sub
End If
Dim tab = objRfcFunc.Tables("FUNCLOC_LIST")
System.Console.WriteLine("Input start:")
For I = 1 To tab.RowCount
For j = 1 To tab.ColumnCount
System.Console.Write(tab.ColumnName(j) + ":")
System.Console.WriteLine(tab.Cell(I, j))
Next
Next
System.Console.WriteLine("Input end.")
I don't intend for this to be an answer, but if it helps then that's good. If it doesn't, I'll delete it.
With objRfcFunc.tables("funcloc_ra")
If .RowCount < 1 Then .Rows.Add
.cell(1, 1) = "I"
.cell(1, 2) = "EQ"
.cell(1, 3) = "Your Func Loc"
End With
Do this after setting objRfcFunc and before calling it. The call will use these parameters.
I means to Include, EQ means you want to find items equal to the value in low.
I'm working on some logic that will remove files from a particular folder if the disk space reaches a defined max capacity, I have the following code:
'Remove files if disk space falls below 100GB
While hDisk.FreeSpace < 100000000000
Set Directory = Fso.GetFolder("C:\backups")
Set Files = Directory.Files
Dim file1
Dim file2
For n = Files.Count - 1 to 0 Step - 1
If IsEmpty(file1) or IsNull(file1) Then
ERROR Here -->Set file1 = Files.Item(n)
ElseIf n > 0 Then
Set file2 = Files.Item(n)
If hDisk.FreeSpace > 100000000000 Then
Exit For
ElseIf file2.DateLastModified < file1.DateLastModified And DateDiff("D", file2.DateLastModified, Now) > 7 Then
file2.Delete
ElseIf file1.DateLastModified < file2.DateLastModified And DateDiff("D", file1.DateLastModified, Now) > 7 Then
file1.Delete
Set file1 = Files.Item(n)
Else
'Nothing
End If
Else
'Nothing
End If
Next
Wend 'End loop when drive is below max capacity
What it's supposed to do is loop through a collection of files in a folder and remove the oldest file(s) until the disk space is above capacity. So there is some file comparison that must be done. I'm encountering a Invalid procedure call or argument error on the line above (see comment). I'd also like to know if this is the best approach, I'm open to better suggestions, preferably ones that will cut down on code.
UPDATE:
Tried adding Set, in front of the assignment statement, but still get the same error.
UPDATE 2 (WORKING SCRIPT!!):
Played with it a bit more and was able to get the script working, here it is in its entirety in case anyone else wants to use it. I added comments to indicate custom values, it can be safely assumed that any other similar value is also customizable, i.e. the disk size is defined in multiple locations.
Dim Fso
Dim hDisk
Dim Directory
Dim Files
Dim myArray()
Set Fso = CreateObject("Scripting.FileSystemObject")
Set hDisk = Fso.GetDrive("c:") 'Custom Value - drive to monitor
If hDisk.FreeSpace < 100000000000 Then
'Delete files until free space is below max capacity (defined here as 100GB)
While hDisk.FreeSpace < 100000000000 'Custom Value - disk size in bytes
Set Directory = Fso.GetFolder("C:\backups") 'Custom Value - Directory to monitor
Set Files = Directory.Files
Redim myArray(Files.Count)
i=0
For Each fl in Files
Set myArray(i)=fl
i=i+1
Next
Dim file1
Dim file2
For n = Files.Count - 1 to 0 Step - 1
'1st PASS: Instantiate first file
If IsEmpty(file1) or IsNull(file1) Then
Set file1 = myArray(n)
'Compare 1st file with next file and current date, remove oldest if it's older than a week
ElseIf n > 0 Then
Set file2 = myArray(n)
If hDisk.FreeSpace > 100000000000 Then
Exit For
ElseIf file2.DateLastModified < file1.DateLastModified And DateDiff("D", file2.DateLastModified, Now) > 7 Then 'Custom Value - File age in number of days
file2.Delete
ElseIf file1.DateLastModified < file2.DateLastModified And DateDiff("D", file1.DateLastModified, Now) > 7 Then
file1.Delete
Set file1 = myArray(n)
Else
'Nothing
End If
'Remove remaining file if it's older than a week
Else
Set file1 = myArray(n)
If DateDiff("D", file1.DateLastModified, Now) > 7 Then
file1.Delete
End If
End If
Next
Wend 'End loop when drive is below max capacity
End If
UPDATE 3:
To clarify what's being done, the pseudocode is as follows:
If disk space is maxed
While disks space is maxed
For each file
If 1st File is empty
Get 1st File
If disk space is below max
Exit
Else Get Next File
If Next File is older than 1st File and older than a week
Delete Next File
Continue
Else if 1st File is older and older than a week
Delete current 1st File
Set 1st File to Next File
Continue
Else if 1st file is the only file and is older than a week
Delete 1st File
Reinventing the wheel. You're trying to create a script to perform a task that already exists in Windows.