Word Excel　VBA テキストタブ区切りUTF-8のファイルを配列として検索して値を取得する

# WordもExcelも可能
[Word VBA テキスト形式のファイルをデータベースとみなして値を挿入するマクロ]( https://qiita.com/Q11Q/items/29da7c938cb745f8de75)
で気がついたのだが、いまからやるExcelと同様、Wordもこれで値が入る。
さらにこの場合、Wordの表のセルでも使える。

#前提
コード UTF-8 65001
区切り文字 TAB
改行 Cr+LF
ヘッダー＝フィールド（項目名）あり
ファイル名 C:\Hoge\Hogehoge\TextDBTab1.txt
<b>取得できる値は必ず一つだとする。もしくは最初にヒットしたレコードが対象となる。</b>
列は4列程度
行（レコード）は最大で50行程度にすること。
選択クエリ（SQL）についての理解が必要となる。

次に配列のお約束として、Option Base 1を宣言していないデフォルトの状態なので、
最初が0列目となり3列だと
0列、1列、2列と3列目は2列目として扱われる。

```text
Col1	Col2	 Col3	
May	    Satsuki	 来週は会う予定
John	Smith	 今週きた
ジョン　 スミス    ジョンさんのカタカナ表記
1000　  昼食代    割り勘で処理
John    Misty    ここは取得されない。
誕生日  01/31/22  
```

しかし、このタブ区切りはできないことはないが、一般的ンはデータベースとしては不向きである。
なぜなら、1列目のテキストの列に1000円と入っている。2列めに日付が入っている。
最後の行はデータが2つしかない。
そこでデータベースではなくタブ区切りの配列として1行ずつ処理する。
1列目にJohnだったら2列めの値を返す。
目標はSmithだ。
なお、今回はデータベースではないので、Schema.iniもない。

###2回め以降は無視
しかし、1列目にJohnはもう一つある。しかし、これは無視される。これは仕様だから仕方がない。
ここが取得したいのであれば、前回のコードが向いている。
これはデータベースではないため、SQLは効かない。つまりソートのようなことはできない。
やろうとしてもWordがはねてしまう。

###長所
データベースとしては使えない、つまりSQLが効かないが、
それでもこの方式にはWordでは重要な長所がある。
この方式だと、Word表のセルに値を入れることができるからである。
前回の記事の方法では表ごと消えてしまう。
テキストの設定項目をWordとExcelで共有できるので、これをチェックすれば、項目と列を間違えない限り、あとは正確になる。
さらに、WordとExcelのコードがほぼ同じである。
接続文字列が入れば簡単ではないが、今回は定数で宣言しているだけで実際は使っていない。
定数Constを宣言しているので、参照設定していなくても、参照設定をしているかのようにコードを書いている。
このためメンテナンスが容易である。
ファイルが変わっても、ファイル名とフォルダだけ書き換えれば良い。
あとは何列目の何を検索し、ヒットしたら何列目の値を返すかを考える。
これも項目ごとにプロシージャを作って必要なものを入力するようにする。
ただし、Excelは一旦関数で値を取得し、あとから値に変換して関数を消しても良い。
こうすることで、関数の項目と列数だけチェックすればいいためである。

####Excelはデータ型を変える2010以降
数値の場合
=Value(Text(RtnRecValue("C:\Hoge\Hogehoge\TextDBTab1.txt", 1, "John", 2),"@"))`
このようにすると数値の場合は数値に変換される。
テキストの場合は`~Text(RtnRecValue("C:\Hoge\Hogehoge\TextDBTab1.txt", 1, "John", 2),"@")`
としてセルに入れる。
[Value 関数](https://support.microsoft.com/ja-jp/office/value-%E9%96%A2%E6%95%B0-257d0108-07dc-437d-ae1c-bc2d3953d8c2)
[Text関数](https://support.microsoft.com/ja-jp/office/text-%E9%96%A2%E6%95%B0-20d5ac4d-7b94-49fd-bb38-93d29371225c)
[VALUE関数で数値を表す文字列を数値に変換する - できるネット](https://dekiru.net/article/4510/)
[TEXT関数で数値に表示形式を適用した文字列を返す - できるネット](https://dekiru.net/article/4509/)
@自体は文字列の中に埋め込むのだが、単体では文字列で返す。（ただしExceLは表示形式を文字列にしていない場合、勝手に数値や日付に変える可能性はある。）
つまりデータ型を変換できるわけである。
また、プロシージャを作らなくても良い。
なにか付加したい文字があれば、@の前後に続ければ良い。

##現在の位置の取得
今回はWordならドキュメントや表のカーソルのある位置、Excelはアクティブなセルに値を入力する。
そのためには現在の位置が取得できなければならない。
そして、それを前提としたほうがコードが簡潔である。

###Excel
基本的にActiveCellに入れることを目的としている。
これは入力したいセルでマクロを起動すれば、ActiveCell.valueとすればいい。

###Word
####DocumentとTable(表)
Wordでは表のことをTableという。表の中の枠をCellという。
結論から言うと、カーソルがある位置は、Activeなんとかとか言わず、単純にRangeで良い。
しかし今回は入力だけだ。
ExcelのRangeととても紛らわしいが、全く違う。
ExcelのRangeとは1つまたは複数のセルの集合のことを指している。
Wordの場合はカーソルがある、または選択範囲になっている場所のことを指す。
少なくともDocumentとTableではそうだ。
Wordでは段落、ページなど様々なレベルでRangeが出てくるので、結構たいへんである。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/126919/fa974286-2751-9c14-c49f-876bfc86dfca.png)


#コード
##Const定数の宣言
###Excel,Word共通
Micrsoft ActiveX X.X Object Libraryを参照設定していなくても動くようにしてある。
今回は使わないが、データベース的に使いたいという場合もあり、接続文字列も宣言しておく。
プロシージャの冒頭に書く。

```vb
Const cnsReadFile = "C:\Hoge\Hogehoge\TextDBTab1.txt" ' UTF-8 Header = True TabDelimited
Const cnsReadFileFolder = "C:\Hoge\Hogehoge\" 'データベースのあるフォルダ。cndReadFileのフォルダー部分。最後にスラッシュ（日本では円記号）を書く
Const cnsConnectionStringPart1 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
Const cnsConnectionStringPart2 = ";Extended Properties=""text;HDR=Yes;FMT=TabDelimited"";"
Const adCrLf = -1, adTypeText = 2, adModeReadWrite = 3, sCharSet = "UTF-8" ' 参照設定をしている場合は不要
```

##関数
###Excel,Word共通

上記の例でいうと
strFileName ファイル名。フルパスで指定
colNumberCreateria 検索したい列の番号0からカウント
sCreteria          検索したい語句
colNumberResult    検索したい語句がヒットし場合、何列目の値を返すか。

```vb
Function RtnRecValue(strFileName As String, colNumberCreateria As Long, sCreteria As String, colNumberResult As Long) As String
’ strFileName 参照するテキストファイル名。フルパスで入れる。
' 検索対象となる列の番号、Col1 1列目は0となる

Dim sr As Object: Set sr = CreateObject("ADODB.Stream")
Dim ar
Dim buf As String
With sr
.Type = adTypeText
.Mode = adModeReadWrite
.Charset = sCharSet
.LineSeparator = adCrLf
.Open
.LoadFromFile strFileName
    '1行毎に処理
    Do Until .EOS
         buf = .ReadText(-2) '1行取り出す
         ar = Split(buf, vbTab) 'TabをDelimiter（データの区切り文字）としてSplit
         If ar(colNumberCreateria) = sCreteria Then '検索する列colNumberCreateriaの値と検索したい語句sCreteriaが一致したら
         RtnRecValue = ar(colNumberResult)
         Exit Do
         End If
    Loop
.Close
End With
If Not sr Is Nothing Then Set sr = Nothing
End Function
```


##Word

```vb
Sub WordinsertTextFromArray()
Selection.Range.Text = RtnRecValue(cnsReadFile, 1, "John", 2)
End Sub
' 上記の関数
```

##Excel

```vb
Sub ExcelinsertTextFromArray()
' Excel Activecell に値を入れる
ActiveCell.Value = RtnRecValue(cnsReadFile, 1, "John", 2)
End Sub
' 上記の関数
````

とこのようになる。

###完成形
####Word

```vb
Const cnsReadFile = "C:\Hoge\Hogehoge\TextDBTab1.txt" ' UTF-8 Header = True TabDelimited
Const cnsReadFileFolder = "C:\Hoge\Hogehoge\" 'データベースのあるフォルダ。cndReadFileのフォルダー部分。最後にスラッシュ（日本では円記号）を書く
Const cnsConnectionStringPart1 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
Const cnsConnectionStringPart2 = ";Extended Properties=""text;HDR=Yes;FMT=TabDelimited"";"
Const adCrLf = -1, adTypeText = 2, adModeReadWrite = 3, sCharSet = "UTF-8" ' 参照設定をしている場合は不要

Sub WordinsertTextFromArray()
Selection.Range.Text = RtnRecValue(cnsReadFile, 1, "John", 2)
End Sub
' 上記の関数
Function RtnRecValue(strFileName As String, colNumberCreateria As Long, sCreteria As String, colNumberResult As Long) As String
’ strFileName 参照するテキストファイル名。フルパスで入れる。
' 検索対象となる列の番号、Col1 1列目は0となる

Dim sr As Object: Set sr = CreateObject("ADODB.Stream")
Dim ar
Dim buf As String
With sr
.Type = adTypeText
.Mode = adModeReadWrite
.Charset = sCharSet
.LineSeparator = adCrLf
.Open
.LoadFromFile strFileName
    '1行毎に処理
    Do Until .EOS
         buf = .ReadText(-2) '1行取り出す
         ar = Split(buf, vbTab) 'TabをDelimiter（データの区切り文字）としてSplit
         If ar(colNumberCreateria) = sCreteria Then '検索する列colNumberCreateriaの値と検索したい語句sCreteriaが一致したら
         RtnRecValue = ar(colNumberResult)
         Exit Do
         End If
    Loop
.Close
End With
If Not sr Is Nothing Then Set sr = Nothing
End Function
```