FS社のAccessを[解析]→ RTF にエクスポートし、指定の文字列のある段落番号と位置を csv に出力するするための関数。本来は ページ−行−桁 を知りたかったのであるが、その方法が解らない...
'概要:第2引数で検索してCSVに書き出す。 Public Function SearchString(argFullName As String, argString As String, argFirst As Boolean) As Long Dim mbTitle As String Dim textFileName As String Dim 段落 As Paragraph Dim dsn As Long, i As Long Dim ctrTotal As Long, nowAddr As Long, ctrPara As Long Dim TextFile As String, TextArea As String Dim NowFileName As String, NowPageCtr As Long, NowAjustCtr As Long mbTitle = MYObjName & "/SearchString" TextFile = Left(argFullName, InStrRev(argFullName, ".", -1)) & "csv" ctrTotal = 0 dsn = FreeFile '初回時のみヘッダーを書き出し、2回目以降はアペンドで開く。 If argFirst Then Open TextFile For Output As #dsn GoSub SearchString_HeaderWrite Else Open TextFile For Append As #dsn End If NowFileName = ActiveDocument.FullName LNGAns = ActiveDocument.Paragraphs.Count '総段落数 ‥‥たぶん ctrPara = 0 For Each 段落 In ActiveDocument.Paragraphs ctrPara = ctrPara + 1 nowAddr = InStr(1, 段落.Range.Text, argString, vbTextCompare) Do While nowAddr > 0 ctrTotal = ctrTotal + 1 NowPageCtr = 段落.Range.Information(wdActiveEndPageNumber) Write #dsn, argString, argFullName, ctrTotal, ctrPara, NowPageCtr, nowAddr nowAddr = InStr(nowAddr + 1, 段落.Range.Text, argString, vbTextCompare) Loop Next 段落 Close #dsn SearchString = ctrTotal Exit_SearchString: Exit Function SearchString_HeaderWrite: Write #dsn, "検索文字", "ファイル名", "検索順", "段落番号", "ページ番号", "検索位置" Return End Function
当面の目的は達したが、何とか改修したいので、コードを載せた。