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
I have the following format in my txt file:
1 1,30705856804525E-7 2,64163961816166E-8
1,12201845645905 1,24157281788939E-7 2,45690063849224E-8
1,25892543792725 1,18248813407718E-7 2,29960868125545E-8
1,41253757476807 1,13006606738963E-7 2,16654658657944E-8
1,58489322662354 1,0842624220686E-7 2,05472137082552E-8
1,77827942371368 1,04479198625995E-7 1,96135836461053E-8
1,99526226520538 1,01119816520168E-7 1,8839035220708E-8
2,23872113227844 9,82917924829962E-8 1,82003176973922E-8
2,51188635826111 9,59338279926669E-8 1,76765304615856E-8
2,81838297843933 9,39840489877497E-8 1,72491425587395E-8
3,16227769851685 9,23831819932275E-8 1,69019571671924E-8
3,54813385009766 9,10766573269939E-8 1,66210121221866E-8
3,98107171058655 9,00157104410937E-8 1,63944182673958E-8
4,46683597564697 8,91577514039454E-8 1,62121711611007E-8
5,01187229156494 8,8466336478632E-8 1,60659361370108E-8
5,6234130859375 8,7910699164695E-8 1,59488209305891E-8
6,30957365036011 8,74651959748007E-8 1,58551749507296E-8
7,07945775985718 8,71086527354237E-8 1,57803938805046E-8
7,94328212738037 8,68237393092386E-8 1,57207402651238E-8
8,91250896453857 8,65963372120859E-8 1,56731942979604E-8
10 8,64150138113473E-8 1,56353241465013E-8
11,2201843261719 8,62705391568852E-8 1,5605175818223E-8
I need to get only value for integers on left and right value so in this example I need to get:
1
2,64163961816166E-8
10
1,56353241465013E-8
This is what I've tried:
' Check Noise Spectral Density.txt exists
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(fso.GetParentFolderName(WScript.ScriptFullName) + "\Projects\Noise Spectral Density.txt")) Then
' Open the file for input.
Set NoiseSpectralDensity = fso.OpenTextFile(fso.GetParentFolderName(WScript.ScriptFullName) + "\Projects\Noise Spectral Density.txt", 1)
' Noise Variables
Dim Noise
' Read from the file and display the results.
Do While NoiseSpectralDensity.AtEndOfStream <> True
' Read Line By Line
TextLine = NoiseSpectralDensity.ReadLine
' Check If Number
'If (IsNumeric(Left(TextLine, 5))) Then
' Get Noise
' Noise # 1kHz
Noise = Right(TextLine, InStr(Mid(TextLine, 2), InStr(TextLine, " ")-1))
x = MsgBox("SNR: " & Split(Left(TextLine, 5), " ")(0) & " NOISE: " & Noise & "",0, "Noise Spectral Density")
'End If
Loop
' Close the file for input.
NoiseSpectralDensity.Close
Else
x = MsgBox("Noise Spectral Density.txt NOT Found!" & vbCrLf & "Wave->Save As Text...", 0, "Noise Spectral Density")
End If
But I could not get left and right numbers in VBScript using Split(TextLine, " ")(0).
Your data seems to be tab-separated, so you could do something like this:
arr = Split(TextLine, vbTab)
If Not (InStr(arr(0), ",") > 0) Then
'first number doesn't have decimals
snr = arr(0)
noise = arr(2)
End If
Though the solution provided by #AnsgarWiechers should work but in case, if it doesn't, you can make use of regular expressions(Replace the whole Do-while loop with the following):
Set objReg = New RegExp
objReg.Pattern = "^(\d+)(?=\s).*\s+([\d,Ee-]+)$" 'See the explanation below
Do While NoiseSpectralDensity.AtEndOfStream <> True
'Read Line By Line
TextLine = NoiseSpectralDensity.ReadLine
' Check If Number
Set objMatches = objReg.Execute(TextLine)
For Each objMatch In objMatches
SNR = objMatch.submatches.item(0)
Noise = objMatch.submatches.item(1)
MsgBox "SNR: "&SNR&"; Noise: "&Noise
Next
Loop
Click for Regex Demo
Regex Explanation:
^ - asserts the start of the string
(\d+) - matches 1+ occurrences of a digit and captures it in Group 1
(?=\s) - positive lookahead to find the position immediately preceded by a white-space. So the digits in the step 2 will be matched until a whitespace(spaces,tabs etc.) is encountered
.* - matches 0+ occurrences of any character except a newline
\s+ - matches 1+ occurrences of a whitespace
([\d,Ee-]+) - matches 1+ occurrences of a digit or , or - or the letter E or e and capture it in group 2
$ - asserts the end of the string
I have no knowledge of VBScript and need help.
Logically - I thought of splitting it with # in a for loop and then using : to split again.
Example:
Text file:
a : 21312 # asdfasd23sad : 43624 # asdsad*:21
Excel file:
Function arr()
input = a : 21312 # asdfasd23sad : 43624 # asdsad*:21
arr1 = Split(input, "#")
For i = Lbound(arr1) To Ubound (arr1)
arr2 = Split(arr1(i),":")
For j = Lbound(arr2) To Ubound (arr2)
Msgbox arr2(j)
Next
Next
End function
Okay, I've searched and searched and am hoping someone here can help me out.
I've been trying to get a VBScript program to open a word document, search for a specific char and replace it with a Addin field (i.e. { SEQ # } )
Here's what I have thus far:
1 Const wdReplaceAll = 2
2 Set objWord = CreateObject("Word.Application")
3 objWord.Visible = True
4
5 Set ObjDoc = objWord.Documents.Open("C:\path\to\.doc")
6 Set objSelection = objWord.Selection
7
8 objSelection.Find.Text = "#"
9 objSelection.Find.Forward = True
10 objSelection.MatchWholeWord = True
11
12 objSelection.Find.Replace.Text = "replacement text"
13
14 objSelection.Find.Execute ,,,,,,,,,,wdReplaceAll
This code works for "Find/Replace" but does not work for fields.
Much help would be awesome! Thanks!
Replace replaces text, but you want to add a field. That's an entirely different thing. I'd suggest to Find the search text (leaves the text selected) and then Add the field (replaces the selected text):
With objWord.Selection
.Find.Text = "#"
.Find.Forward = True
.Find.MatchWholeWord = True
.Find.Execute
.Fields.Add .Range, -1, "SEQ #", True
End With
To replace all occurrences of the search string you have to create a loop that keeps executing .Find.Execute until no further occurrences are found. The return value of the Execute method indicates if another match was found.
With objWord.Selection
.Find.Text = "#"
.Find.Forward = True
.Find.MatchWholeWord = True
Do
found = .Find.Execute
If found Then .Fields.Add .Range, -1, "SEQ #", True
Loop While found
End With
Make sure your cursor is positioned at the beginning of the document before you run the above code, otherwise you might miss occurrences of your search text.
Here I have a small VBS script that helps me append a new line to a table in MS "Word" 2003:
Set wd = CreateObject("Word.Application")
wd.Visible = True
Set doc = wd.Documents.Open ("c:\addtotable.doc")
Set r = doc.Tables(1).Rows.Add
aa = Split("turtle,dog,rooster,maple", ",")
For i = 0 To r.Cells.Count - 1
r.Cells(i + 1).Range.Text = aa(i)
Next
It works fine, but it doesn't save anything. I want it to save the performed changes.
By the method of macro-recording in the "Word" I got this macro command that saves active "Word" document:
ActiveDocument.Save
So, I decided to append this macro to the VBS script above:
Set wd = CreateObject("Word.Application")
wd.Visible = True
Set doc = wd.Documents.Open ("c:\addtotable.doc")
Set r = doc.Tables(1).Rows.Add
aa = Split("turtle,dog,rooster,maple", ",")
For i = 0 To r.Cells.Count - 1
r.Cells(i + 1).Range.Text = aa(i)
Next
ActiveDocument.Save
But it doesn't save anything. What am I doing wrong here?
Have you already tried calling doc.Save after making those changes? If that doesn't work:
The issue is that ActiveDocument doesn't automatically reference what you think it does in VBScript the way it does in Word's VBA.
Try setting a new variable to the active document, like so:
Dim activeDoc
Set activeDoc = wd.ActiveDocument
activeDoc.Save
I think you have to use ActiveDocument.SaveAs("C:\addtotable.doc"); because I can't find any documentation for .Save. SaveAs accepts a second parameter which specifies what format to save it in. Pastebin of the parameters here.