# Need help with vbscript to parse text file



## virtech (Jun 12, 2010)

I'm trying to adapt this script to work on Vista/7. Currently it works in XP only. Conversion to powershell would also be ok. The script simply takes an input text file, parse it for the content between patrenthese and write the findings to an outtput file, removing the duplicates as a final step. 
Any help would be great!

Option Explicit

Private Sub removeDuplicates(arrName())
Dim i, tempArr()
ReDim tempArr(UBound(arrName))
Dim d, n
Set d = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(arrName)
If Not d.Exists(arrName(i)) Then
d.Add arrName(i), arrName(i)
tempArr = arrName(i): n = n + 1
End If
Next
ReDim Preserve tempArr
arrName = tempArr
End Sub 

Function RemDups(ByVal anArray)
Dim d, item, thekeys
Set d = CreateObject("Scripting.Dictionary")
d.removeall
d.CompareMode = 0
For Each item In anArray
If Len(item) > 0 Then
If Not d.Exists(item) Then d.Add item, item
End If
Next
thekeys = d.keys
Set d = Nothing
RemDups = thekeys
End Function


Dim ObjFSO, InitFSO

'create an instance of the File Browser
Set ObjFSO = CreateObject("UserAccounts.CommonDialog")

'setup the File Browser specifics
ObjFSO.Filter = "Text Files|*.txt|All Files|*.*"
ObjFSO.FilterIndex = 1
'ObjFSO.InitialDir = "c:\"
ObjFSO.InitialDir = "\"

'show the file browser and return the selection (or lack of) to InitFSO
InitFSO = ObjFSO.ShowOpen

If InitFSO = False Then
'Wscript.Echo "Script Error: Please select a file!"
Wscript.Quit
Else

Dim i, strFile, arrResults(), objFile, strLine, strResult
strFile = ObjFSO.FileName

i = 0
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, 1)
Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
If InStr(strLine,"(") > 1 AND InStr(strLine,"(") > 1 Then
strResult = Mid(strLine, InStr(strLine,"(")+1, InStr(strLine,")")-InStr(strLine,"(")-1)
If InStr(strResult,".") > 1 Then
Redim Preserve arrResults(i)
arrResults(i) = strResult
i = i + 1
End If
End If
Loop
objFile.Close

'arrResults() = removeDupsArray(arrResults())
'removeDuplicates arrResults
'arrResults() = RemDups(arrResults)

Dim sNewList, aList, maxItems, strResults, x
aList = arrResults
maxItems = UBound(aList)
For x = 0 To maxItems
If InStr(sNewList,(aList(x) & ",")) <= 0 Then
sNewList = sNewList & aList(x) & ","
End If
Next
strResults = Left(sNewList,Len(sNewList)-1)

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("C:\mbam.txt", True)

objFile.Write(strResults)
objFile.Write(vbcrlf & vbcrlf)
objFile.Write(Replace(strResults,",",vbcrlf))

Dim l
'For l = Lbound(removeDupsArray) to UBound(removeDupsArray)
'	objFile.Write(removeDupsArray(l) & ", ")
'Next
'	For l = Lbound(arrResults) to UBound(arrResults)
' objFile.Write(arrResults(l) & ", ")
'	Next
'	objFile.Write(vbcrlf & vbcrlf)
'	For l = Lbound(arrResults) to UBound(arrResults)
' objFile.WriteLine(arrResults(l))
'	Next
objFile.Close

Dim objShell
Set objShell = CreateObject("WScript.Shell")
objShell.Run("notepad C:\mbam.txt")

End If


----------



## TheOutcaste (Mar 19, 2009)

You'll need to replace the FileOpen dialog, as *CreateObject("UserAccounts.CommonDialog")*
doesn't work in Vista or Windows 7
Three different options shown here:
Browse for File dialog
For *MSComDlg.CommonDialog* to work you need to have MSOffice or VisualBasic, or some other program that includes it installed.

Also, I'm guessing this line is to check for a line that has *both* an open and close parenthesis. However, it only checks for an open, not a close:

```
If InStr(strLine,"(") > 1 AND InStr(strLine,"(") > 1 Then
```
that should probably be this:

```
If InStr(strLine,"(") > 1 AND InStr(strLine,")") > 1 Then
```
(Without the extra spaces the editor added due to the red color)


----------

