vbscriptの偽条件処理について

質問

VBスクリプトで以下の処理をさせたいのですが
行き詰まってしまいました。お助けください

以下のようにfilename.txtというファイルがあり
人名と文字列があります。
このうち、特定の文字列が"存在しない"人名を出力したいのです。

例えば、「abcde」をキーとするとyamada,satoを出力したいです。
「zzzz9」をキーとするとyamadaと出力する具合です。
よろしくお願いいたします

filename.txt(定義ファイル)
----------------------
yamada xxx1
yamada yyy4
tanaka zzzz9
tanaka abcde
sato zzzz9
----------------------

回答No.1

nda23 · ベストアンサー

データベースエンジンを使うのはどうでしょうか？
次の想定でプログラムしています。
(1)入力ファイルはヘッダがなく、１行目から有効データと見なす。
(2)項目の区切りは各行、例外なく半角スペース１個とする。
(3)入力ファイルの加工先は出力ファイルパス内にtemp.txtで作る。
(4)入力ファイルは最大で138Mバイトを超えない。
★インデントに漢字空白を使っています。
　コピペして即使うとエラーになります。
'**
'*　キーワードを含まない名前の抽出
'*　@param　InFilePath　As String　 入力ファイルのパス名
'*　@param　InFileName　As String　 入力ファイルのファイル名
'*　@param　KeyWord　　 As String　 除外用キーワード
'*　@param　OutFilePath As String　 出力ファイルのパス名
'*　@param　OutFileName As String　 出力ファイルのファイル名
'*
Sub SelectOmit(ByVal InFilePath, ByVal InFileName, ByVal KeyWord, _
　　　　　　　　　　　　 ByVal OutFIlePath, ByVal OutFileName)
Dim ITS '入力側オブジェクト
Dim OTS '出力側オブジェクト
Dim TXT '文字列用ワーク
Dim CON '接続オブジェクト
Dim RST 'レコードセット

'パスの終端に区切り文字を付ける
If Right(InFilePath, 1) <> "\" Then InFilePath = InFilePath & "\"
If Right(OutFIlePath, 1) <> "\" Then OutFIlePath = OutFIlePath & "\"
'入力ファイルを編集する(ヘッダあり、カンマ区切りなら不要)
Set ITS = CreateObject("ADODB.Stream")
ITS.Open
ITS.Type = 2 'Textモード
ITS.Charset = "shift_jis"
On Error Resume Next
ITS.LoadFromFile InFilePath & InFileName
TXT = Err.Description
On Error GoTo 0
'エラーなら終了する
If TXT <> "" Then
　　　　ITS.Close
　　　　MsgBox TXT, vbCritical
　　　　Exit Sub
End If
Set OTS = CreateObject("ADODB.Stream")
OTS.Open
OTS.Type = 2 'Textモード
OTS.Charset = "shift_jis"
OTS.WriteText "N,K" & vbNewLine
'データ量が138M超の場合は小分けにループする
OTS.WriteText Replace(ITS.ReadText, " ", ",")
ITS.Close
On Error Resume Next
OTS.SaveToFile OutFIlePath & "temp.txt", 2 '上書き許可
TXT = Err.Description
On Error GoTo 0
'エラーなら終了する
If TXT <> "" Then
　　　　OTS.Close
　　　　MsgBox TXT, vbCritical
　　　　Exit Sub
End If
'ADOのConnectionをインスタンス化する
Set CON = CreateObject("ADODB.Connection")
'接続文字列を編集する
TXT = "Provider=Microsoft.Jet.OLEDB.4.0;"
TXT = TXT & "Data Source=" & OutFIlePath & ";"
TXT = TXT & "Extended Properties=""TEXT;HDR=YES;"""
'接続する
On Error Resume Next
CON.Open TXT
TXT = Err.Description
On Error GoTo 0
'エラー検出時は終了する
If TXT <> "" Then
　　　　MsgBox TXT, vbCritical
　　　　Exit Sub
End If
'SQLを作る
TXT = "SELECT N FROM temp.txt"
TXT = TXT & " GROUP BY N HAVING"
TXT = TXT & " SUM(IIf(K='" & KeyWord & "',1,0))=0"
'レコードセットを作る
Set RST = CON.Execute(TXT)
'出力ファイルを準備する
OTS.Position = 0
OTS.SetEOS
'EOFまで繰り返す
Do Until RST.EOF
　　　　OTS.WriteText RST.Fields(0).Value & vbNewLine
　　　　RST.MoveNext
Loop
'レコードセットを閉じる
RST.Close
'ファイルを出力する
OTS.SetEOS
On Error Resume Next
OTS.SaveToFile OutFIlePath & OutFileName, 2 '上書き許可
TXT = Err.Description
On Error GoTo 0
'出力ファイルを閉じる
OTS.Close
'編集したファイルを削除する
CreateObject("Scripting.FileSystemObject").DeleteFile _
　　　　OutFIlePath & "temp.txt", True
'エラーを検出していたら表示する
If TXT <> "" Then MsgBox TXT, vbCritical
End Sub