Excelのワークシートに配置してあるテキストボックス内の文字列をAccessのメモフィールドに転送するサンプルプログラムを作ったので覚え書きしておく。
紹介するサンプルプログラムについて
Excelのワークシートの内容をAccessのデータベースにプログラムを使ってインポートする際に使用したプログラム。
注意する点として、文字数が255を超える場合、何も考えないで実行すると255文字で切れてしまうので、255文字ずつ取り出して、取りだした文字列を結合したものをフィールドに代入するというロジックが必要になる。
また、ExcelとAccessでは改行コードの扱いが若干異なるため、改行コードをAccess側の仕様に合わせてからデータを転送する必要がある。
ExcelとAccessの改行コードの扱いについては、以下の記事を参照して下さい。
VBAのサンプルプログラム
以下のVBAのサンプルプログラムは、Excelのファイル"c:\test\test.xls"を読み込み、"test.xls"のワークシート"Sheet1"に配置されたテキストボックス1つ1つのデータを1件のレコードとしてAccessのデータベース"test.mdb"の"sample"テーブルに追加する処理。
VBAのサンプルプログラムその1
Sub TransferXLTextboxData()
Dim xl As Object, xlsh As Object
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open "c:¥test¥test.xls"
Set xlsh = xl.ActiveWorkbook.Worksheets("sheet1")
Dim con As New ADODB.Connection, rec As New ADODB.Recordset
Dim txt As String, objText As Object, Counter As Integer, LastChar As Integer
Dim i As Integer, j As Integer
Set con = CurrentProject.Connection
rec.Open "sample", con, adOpenDynamic, adLockOptimistic
For Each objText In xlsh.Shapes
If objText.Type = 17 Then
Counter = Int(objText.TextFrame.Characters.Count / 255)
If Counter >= 1 Then
LastChar = objText.TextFrame.Characters.Count Mod 255
i = 0
For j = 1 To Counter
txt = txt & objText.TextFrame.Characters(i * 255 + 1, 255).Text
i = i + 1
Next j
txt = txt & objText.TextFrame.Characters(Counter * 255 + 1, LastChar).Text
Else
txt = objText.TextFrame.Characters.Text
End If
'取得したテキストボックスのデータをAccessのsampleテーブルのメモフィールドF1に追加する
rec.AddNew
rec("f1") = Replace(txt, Chr(10), vbCrLf)
rec.Update
txt = Empty
End If
Next
rec.Close
con.Close
xl.Quit
End Sub
VBAのサンプルプログラムその2
以下のサンプルプログラムは、上記のサンプルと違い、配置されたテキストボックス1つ1つのデータを改行コードをはさんで結合し、1つのデータにしてから1件のレコードとして"sample"テーブルに追加する処理。
Excelのワークシート上の全てのテキストボックスの値を1つにまとめて1レコードして扱いたい場合に使用する。
Sub TransferXLAllTextboxData()
'Excelをオブジェクトにセットする処理
Dim xl As Object, xlsh As Object
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open "c:¥test¥test.xls"
Set xlsh = xl.ActiveWorkbook.Worksheets("sheet1")
'Excelのワークシート上のテキストボックスのデータを全て結合して1つの文字列データとする処理
Dim txt As String, objText As Object, Counter As Integer, LastChar As Integer
Dim tempText As String, j As Integer, i As Integer
For Each objText In xlsh.Shapes
If objText.Type = 17 Then
Counter = Int(objText.TextFrame.Characters.Count / 255)
If Counter >= 1 Then
LastChar = objText.TextFrame.Characters.Count Mod 255
i = 0
For j = 1 To Counter
txt = txt & objText.TextFrame.Characters(i * 255 + 1, 255).Text
i = i + 1
Next j
txt = txt & objText.TextFrame.Characters(Counter * 255 + 1, LastChar).Text
Else
txt = objText.TextFrame.Characters.Text
End If
tempText = tempText & Replace(txt, Chr(10), vbCrLf) + vbCrLf
txt = Empty
End If
Next
'結合された文字列データをAccessのsampleテーブルに保存する処理
Dim con As New ADODB.Connection, rec As New ADODB.Recordset
Set con = CurrentProject.Connection
rec.Open "sample", con, adOpenDynamic, adLockOptimistic
'取得したテキストボックスのデータをAccessのsampleテーブルの
'メモフィールドF1に追加する
rec.AddNew
rec("f1") = tempText
rec.Update
rec.Close
con.Close
xl.Quit
End Sub
VBAのサンプルプログラムの解説
うーん、めんどくさい...でも忘れてあとで「なんだこの処理?」ってことになっても困るので概要だけ記述。
255文字を超える文字列がテキストボックスに入力されている場合は、単純にTextプロパティの値を取得しても255文字で切れる。
したがって、255文字以上ある場合複数回に分けて取り出して結合する処理が必要。
何回に分ける必要があるかは、テキストボックスの文字列を255で割った値を切り上げすれば出る。
すなわち、以下のようなコードになる。
Counter = Int(objText.TextFrame.Characters.Count / 255)
文字列が600文字あったとすると 600 / 255 = 2.35..... なのでIntでくくると2が返ってくる。
つまり、255文字取り出す処理を2回して、あとは、600 - (255 X 2) = 90 文字を取って全部つなげればよいことになる。
文字列の取り出しは、1回目は1文字目から255文字目まで、2回目は255文字目+1文字目から255文字になる。
取り出す回数分Forループで繰り返す。
取り出して結合した結果を別の文字列変数tempTextに改行コードをAccessの仕様に合わせた上で移しておいて、基の変数txtは、中身をクリアして次のテキストボックスのデータが入るようにする。
最終的にテキストボックスの数だけ処理を繰り返して、全てを結合した結果となるtempText変数をテーブルに保存する。
これぐらい書いておけば思い出せるかな...
コメント