WordもExcelも可能
Word VBA テキスト形式のファイルをデータベースとみなして値を挿入するマクロ
で気がついたのだが、いまからやるExcelと同様、Wordもこれで値が入る。
さらにこの場合、Wordの表のセルでも使える。
前提
コード UTF-8 65001
区切り文字 TAB
改行 Cr+LF
ヘッダー＝フィールド（項目名）あり
ファイル名 C:\Hoge\Hogehoge\TextDBTab1.txt
取得できる値は必ず一つだとする。もしくは最初にヒットしたレコードが対象となる。
列は4列程度
行（レコード）は最大で50行程度にすること。
選択クエリ（SQL）についての理解が必要となる。
次に配列のお約束として、Option Base 1を宣言していないデフォルトの状態なので、
最初が0列目となり3列だと
0列、1列、2列と3列目は2列目として扱われる。
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 関数
Text関数
VALUE関数で数値を表す文字列を数値に変換する - できるネット
TEXT関数で数値に表示形式を適用した文字列を返す - できるネット
@自体は文字列の中に埋め込むのだが、単体では文字列で返す。（ただし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が出てくるので、結構たいへんである。
コード
Const定数の宣言
Excel,Word共通
Micrsoft ActiveX X.X Object Libraryを参照設定していなくても動くようにしてある。
今回は使わないが、データベース的に使いたいという場合もあり、接続文字列も宣言しておく。
プロシージャの冒頭に書く。
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 検索したい語句がヒットし場合、何列目の値を返すか。
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
Sub WordinsertTextFromArray()
Selection.Range.Text = RtnRecValue(cnsReadFile, 1, "John", 2)
End Sub
' 上記の関数
Excel
Sub ExcelinsertTextFromArray()
' Excel Activecell に値を入れる
ActiveCell.Value = RtnRecValue(cnsReadFile, 1, "John", 2)
End Sub
' 上記の関数
とこのようになる。
完成形
Word
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