Access 標準モジュール 条件分岐について

質問

お世話になります。　先日似たような質問をさせて頂き、解決したのですが改めて
新たな不明点が発生してしまい、依頼されている内容の為、恥ずかしながら質問させて
頂きたいと思います。
長くなってしまうかもしれませんが、できるだけ詳細に書きたいと思いますので
よろしければご協力おねがいします。

行いたい内容として、テキストファイルを利用して、Accessのテーブルに希望の内容を
書き込むことを目的としているのですが、個人でも本やネットを利用して、調べたりしているんですが、現状の自分の理解度を超えており、質問させて頂きたいと思います。

ご面倒かけ申し訳ありませんが、よろしくお願いいたします。

＜テキストファイル＞
AAA 1000 2000 3000 5000
BBB 3
2000 5000
1500 3000
1000 1500
AAA 300 800 1500 1000
BBB 4
1000 3000
1000 2500
2000 1300
1500 3000
BBB 2
5000 2000
2000 1000

上記のようなテキストファイルがあるのですが、これをＡｃｃｅｓｓのテーブルへaddnewとupdateを
利用して書き込みを行いたいと思っています。

＜テーブル構成＞
ID　　　　　　 オートナンバー
フィールド1　テキスト型
連番　　　　　数値型

このテーブル構成に対して、標準モジュールを利用して、下記のように加工したいです。
多少文字がずれてしまっていたら申し訳ありません。

＜実行後のテーブル＞
　ID　　　　　フィールド1　　　連番　　
　1　　　　　1000 2000　　　　 1
　2　　　　　3000 5000 　　　　1
　 3　　　　　2000 5000　　　　 2
　4　　　　　1000 1500　　　　 2
　5　　　　　　300 800　　　　 3
　6　　　　　1500 1000　　　　 3
　 7　　　　　1000 3000　　　　 4
　 8　　　　　1500 3000　　　　 4
　 9　　　　　5000 2000　　　　 5
　10　　　　 2000 1000　　　　 5

ポイントとしまして
(1)　AAAで始まる行については、2行に分ける
　　 1000 2000 3000 5000 数字の間は、半角のスペース一つ分空いています。
　　 Line Inputとｓｐｌｉｔを利用して、配列で利用したいと思っています。
(2)　BBBで始まる行については、最初の行と最後の行のみを利用します。　
　　 間にあるデータは利用しません。
(3)　ＡＡＡ・ＢＢＢの半角スペースの横にある数字は、次の行から何行データがあるか
　　 表しています。
(4)　ＡＡＡは、必ず2行になります。ＢＢＢは、最低2行になります。
(5)　連番については、AAA ・BBBともに、2行が同じ番号になります、

とりあえずできている内容を記載しておきます。
まだ条件分岐が全然できていません。
途中段階ではありますが、間違っている点・追加した方がいい点等ありましたら
変更していただいても大丈夫です。

Sub test()

Dim rsd As New ADODB.Recordset
Dim strLine As String
Dim arraystr As Variant

Dim iNum1 As Long
Dim iNum2 As Long
Dim iRecCnt As Long
　 Dim i As Long

'カレントファイルを開く
Open CurrentProject.Path & "\abcde.txt" For Input As #1

iNum1 = 0
iRecCnt = 0

Const sTable As String = "test1"

'abcdeテーブルデータ削除
Dim sSql As String
sSql = "DELETE * FROM " & sTable & ";"
CurrentProject.Connection.Execute sSql

'abcdeテーブルオープン
rsd.Open sTable, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic

Do While Not EOF(1)
'テキスト データを一行ずつ読込
Line Input #1, strLine

'Nullを区切りとして配列をarraystrへ
arraystr = Split(strLine, " ")

　 Loop

End Sub

以上　よろしくお願いいたします

回答No.7

piroin654

No4に余計なものを残していました。結果には何ら影響は
ないのですが、余計なループをしていました。ほかの
ことを考えていたためそのままにしていました。
取り除いたのは、

For i = 0 To UBound(arrayText)
と、途中の
Exit For
および
Next i

です。

したがって以下のようになります。
ADOに置き換えるのはNo6での記述に変更はありません。
失礼しました。

Sub test21()
　　Dim LineofText As String
　　Dim arrayText As Variant
　　Dim strPath As String
　　Dim i As Long
　　Dim j As Long
　　Dim flg As Long
　　Dim lnCount As Long
　　Dim db As DAO.Database
　　Dim rs As DAO.Recordset

　　Set db = CurrentDb
　　Set rs = db.OpenRecordset("test", dbOpenDynaset)

　　j = 0
　　flg = 0
　　lnCount = 0
　　'テキストファイルを開く
　　Open CurrentProject.Path & "\テキスト.txt" For Input As #1
　　'一行ずつ変数に読み込む
　　Do While Not EOF(1)
　　'ループのカウント
　　lnCount = lnCount + 1
　　　　Line Input #1, LineofText
　　　　'配列にデータを格納
　　　　arrayText = Split(LineofText, " ")
　　　　　　'配列の要素をテーブルに格納するための条件分岐
　　　　　　Select Case arrayText(0)

　　　　　　Case "AAA"
　　　　　　　　'連番の加算
　　　　　　　　j = j + 1
　　　　　　　　'"AAA"の場合のデータの書き込み
　　　　　　　　rs.AddNew
　　　　　　　　　　rs!フィールド1 = arrayText(1) & " " & arrayText(2)
　　　　　　　　　　rs!連番 = j
　　　　　　　　rs.Update

　　　　　　　　rs.AddNew
　　　　　　　　　　rs!フィールド1 = arrayText(3) & " " & arrayText(4)
　　　　　　　　　　rs!連番 = j
　　　　　　　　rs.Update
　　　　　　　　Erase arrayText

　　　　　　Case "BBB"
　　　　　　　　'カウンタとフラッグの初期化
　　　　　　　　lnCount = 0
　　　　　　　　flg = 0
　　　　　　　　'フラッグの設定
　　　　　　　　flg = arrayText(1)
　　　　　　　　'配列の初期化
　　　　　　　　Erase arrayText
　　　　　　　　'連番の加算
　　　　　　　　j = j + 1

　　　　　　Case Else
　　　　　　　　'最初と最後のデータの位置の設定
　　　　　　　　If lnCount = 1 Or flg = lnCount Then
　　　　　　　　　　'"BBB"の場合のデータの書き込み
　　　　　　　　　　rs.AddNew
　　　　　　　　　　　　rs!フィールド1 = arrayText(0) & " " & arrayText(1)
　　　　　　　　　　　　rs!連番 = j
　　　　　　　　　　rs.Update
　　　　　　　　　　Erase arrayText
　　　　　　　　End If
　　　　　　End Select
　　Loop
　　Close #1
　　rs.Close: Set rs = Nothing
　　db.Close: Set db = Nothing
End Sub

回答No.6

piroin654

No4です。
質問ではADOとなっているので、No4をADOに変更する場合は、
最初の部分の変数とレコードセットのオープンまでは、
変更はADOの宣言の部分で、変数も合わせると、

　　Dim LineofText As String
　　Dim arrayText As Variant
　　Dim strPath As String
　　Dim i As Long
　　Dim j As Long
　　Dim flg As Long
　　Dim lnCount As Long
　　Dim cn As ADODB.Connection
　　Dim rs As ADODB.Recordset

　　Set cn = CurrentProject.Connection
　　Set rs = New ADODB.Recordset

　　rs.Open "test", cn, adOpenForwardOnly, adLockPessimistic

上記以降はずーっと同じで、最後のオブジェクトの処理で、

　　rs.Close: Set rs = Nothing
　　cn.Close: Set cn = Nothing
End Sub

となります。
中身は変わりませんが、以上です。

回答No.5

30246kiku

＃２です

記述の勉強されているという事なので、何件か紹介します。
（参考にする/しない等々、自己責任でお願いします）

> 無駄を省くなりしてください。
と記述していましたが、TextToRec で
・登録する部分の関数化はやめる
・呼び飛ばす行分の領域はいらない
とした場合、以下の様な感じにも書けます。

Public Sub TextToRec2()
　　Dim rs As New ADODB.Recordset
　　Dim ffn As Integer
　　Dim iNum As Long
　　Dim sR As String, sSrc As String, sAry() As String
　　Dim i As Long, iRecCnt As Long
　　Dim sSql As String
　　Const sTable As String = "test1"
　　Const sFile As String = "\abcde.txt"

　　sSql = "DELETE * FROM " & sTable & ";"
　　CurrentProject.Connection.Execute sSql
　　rs.Open sTable, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic

　　iNum = 1
　　ffn = FreeFile()
　　Open CurrentProject.Path & sFile For Input As #ffn
　　While (Not EOF(ffn))
　　　　Line Input #ffn, sR
　　　　If (Left(sR, 3) = "AAA") Then
　　　　　　sSrc = Mid(sR, 5)
　　　　Else
　　　　　　iRecCnt = CLng(Split(sR, " ")(1))
　　　　　　For i = 1 To iRecCnt
　　　　　　　　Line Input #ffn, sR
　　　　　　　　Select Case i
　　　　　　　　　　Case 1: sSrc = sR
　　　　　　　　　　Case iRecCnt: sSrc = sSrc & " " & sR
　　　　　　　　End Select
　　　　　　Next
　　　　End If

　　　　sAry = Split(sSrc, " ")
　　　　For i = 0 To 2 Step 2
　　　　　　rs.AddNew
　　　　　　rs("フィールド1") = sAry(i) & " " & sAry(i + 1)
　　　　　　rs("連番") = iNum
　　　　　　rs.Update
　　　　Next
　　　　iNum = iNum + 1
　　Wend
　　Close #ffn
　　rs.Close
End Sub

もう１つ違う方法を紹介します。前回のご質問

Access VBA を利用 連番（＋１）方法
http://okwave.jp/qa/q7776428.html

最後で schema.ini を使う手も・・・・と言ってましたが、以下で使ってみます。
abcde.txt を読み込む時に、Recordset として扱うように。
スペースで区切ったものが、フィールド何個目として扱えるので、
自分で頑張って Split しなくても良くなります。

以下の内容をメモ帳にコピーし、schema.ini 名で、abcde.txt と同じところに保存します。

[abcde.txt]
ColNameHeader=False
CharacterSet=OEM
Format=Delimited( )
Col1=F1 Char Width 255
Col2=F2 Char Width 255
Col3=F3 Char Width 255
Col4=F4 Char Width 255
Col5=F5 Char Width 255

内容的には、
abcde.txt の情報です。
ヘッダ（項目部分）はありません。
区切りは、スペースです。
区切った結果、左から F1 ～ F5 名として、テキスト型で扱って・・・
記述の詳細は、Web検索されると結構ありますので、そちらで理解してください。

前回のご質問では、このような定義をしていなかったので、Access さんが何行か読んで
この項目は、テキスト型として扱いましょうか・・・・等解釈しています。
品名のところを文字列にしていたら、テキスト型だね・・・・で、AAA がそのまま得られました。
品名のところを数字にしたら、数値として扱おうかな・・・で、AAA は数値じゃないので Null に。
なので、あの部分はうまくいっているように見えても、他のところはしっかり確認してください。

では、abcde.txt を Recordset として扱う例は以下です。

Public Sub TextToRec3()
　　Dim rs As New ADODB.Recordset
　　Dim rsFrom As New ADODB.Recordset
　　Dim iNum As Long
　　Dim i As Long, iRecCnt As Long
　　Dim sSql As String
　　Const sTable As String = "test1"
　　Const sFile As String = "abcde.txt"

　　sSql = "DELETE * FROM " & sTable & ";"
　　CurrentProject.Connection.Execute sSql
　　rs.Open sTable, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic

　　iNum = 1
　　rsFrom.Source = "SELECT * FROM [" & sFile & "] IN '" _
　　　　　　& CurrentProject.Path & "'[text;];"
　　rsFrom.Open , CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
　　While (Not rsFrom.EOF)
　　　　If (rsFrom(0) = "AAA") Then
　　　　　　For i = 1 To 3 Step 2
　　　　　　　　rs.AddNew
　　　　　　　　rs("フィールド1") = rsFrom(i) & " " & rsFrom(i + 1)
　　　　　　　　rs("連番") = iNum
　　　　　　　　rs.Update
　　　　　　Next
　　　　Else
　　　　　　iRecCnt = CLng(rsFrom(1))
　　　　　　For i = 1 To iRecCnt
　　　　　　　　rsFrom.MoveNext
　　　　　　　　If ((i = 1) Or (i = iRecCnt)) Then
　　　　　　　　　　rs.AddNew
　　　　　　　　　　rs("フィールド1") = rsFrom(0) & " " & rsFrom(1)
　　　　　　　　　　rs("連番") = iNum
　　　　　　　　　　rs.Update
　　　　　　　　End If
　　　　　　Next
　　　　End If
　　　　rsFrom.MoveNext
　　　　iNum = iNum + 1
　　Wend
　　rsFrom.Close
　　rs.Close
End Sub

前回のご質問での記述と、今回の記述の大きく異なる点は

前回）　[Text;FMT=Delimited;HDR=YES;IMEX=1;]
今回）　[Text;]

Schema.ini を使う時には、IMEX 記述があると解釈してくれないようです。
それを削除すると、区切り、ヘッダ情報は Schema.ini にあるので、あわせて削除。

という感じになっています。

※ 紹介した方法での各処理性能は分かりません。
＃２での TextToRec / 今回の TextToRec2 の処理は、AAA の文字列に合わせましょう・・・
その合わせた文字列を展開して、２レコードを一緒に登録しましょう・・・・
としていましたが、BBB の出現頻度が多い・・・等々なら記述を見直したりしていきます。

回答No.4

piroin654

No3です。
解決されたのかもしれませんが、再度回答します。
DAOやその他の設定はNo1と同じです。

質問の、
(2)　BBBで始まる行については、最初の行と最後の行のみを利用します。　
　　 間にあるデータは利用しません。
については、
flgとlnCountという二つの数値を見比べてflg=1の場合と、
flg=lnCountの場合にデータを取り出すということで
クリアしています。
flgはたとえば"BBB 3"のときの3を表し、lnCountはループの回数
を表しています。

Sub test21()
　　Dim LineofText As String
　　Dim arrayText As Variant
　　Dim strPath As String
　　Dim i As Long
　　Dim j As Long
　　Dim flg As Long
　　Dim lnCount As Long
　　Dim db As DAO.Database
　　Dim rs As DAO.Recordset

　　Set db = CurrentDb
　　Set rs = db.OpenRecordset("test", dbOpenDynaset)

　　j = 0
　　flg = 0
　　lnCount = 0
　　'テキストファイルを開く
　　Open CurrentProject.Path & "\テキスト.txt" For Input As #1
　　'一行ずつ変数に読み込む
　　Do While Not EOF(1)
　　'ループのカウント
　　lnCount = lnCount + 1
　　　　Line Input #1, LineofText
　　　　'配列にデータを格納
　　　　arrayText = Split(LineofText, " ")
　　　　'配列の要素をテーブルに格納
　　　　For i = 0 To UBound(arrayText)

　　　　　　Select Case arrayText(0)

　　　　　　Case "AAA"
　　　　　　　　'連番の加算
　　　　　　　　j = j + 1
　　　　　　　　'"AAA"の場合のデータの書き込み
　　　　　　　　rs.AddNew
　　　　　　　　rs!フィールド1 = arrayText(1) & " " & arrayText(2)
　　　　　　　　rs!連番 = j
　　　　　　　　rs.Update

　　　　　　　　rs.AddNew
　　　　　　　　　　rs!フィールド1 = arrayText(3) & " " & arrayText(4)
　　　　　　　　　　rs!連番 = j
　　　　　　　　rs.Update

　　　　　　　　Erase arrayText
　　　　　　　　Exit For

　　　　　　Case "BBB"
　　　　　　　　'カウンタとフラッグの初期化
　　　　　　　　lnCount = 0
　　　　　　　　flg = 0
　　　　　　　　'フラッグの設定
　　　　　　　　flg = arrayText(1)
　　　　　　　　'配列の初期化
　　　　　　　　Erase arrayText
　　　　　　　　'連番の加算
　　　　　　　　j = j + 1
　　　　　　　　Exit For

　　　　　　Case Else
　　　　　　　　'最初と最後のデータの位置の設定
　　　　　　　　If lnCount = 1 Or flg = lnCount Then
　　　　　　　　　　'"BBB"の場合のデータの書き込み
　　　　　　　　　　rs.AddNew
　　　　　　　　　　　　rs!フィールド1 = arrayText(0) & " " & arrayText(1)
　　　　　　　　　　rs!連番 = j
　　　　　　　　　　rs.Update
　　　　　　　　　　Erase arrayText
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　End Select
　　　　Next i
　　Loop
　　Close #1
　　rs.Close: Set rs = Nothing
　　db.Close: Set db = Nothing
End Sub

回答No.3

piroin654

No1です。

＞(2)　BBBで始まる行については、最初の行と最後の行のみを利用します。　
＞　　 間にあるデータは利用しません

の条件を抜かしていました。No1は一旦取り下げます。

回答No.2

30246kiku

何をやっているか、わかりやすそうな感じで書いてみました。
実際にはエラー処理を盛り込んだり、無駄を省くなりしてください。

連番を振る部分は、関数として独立。
・左３文字が AAA ならその後ろの文字列をそのまま
・AAA じゃなかったら必要な行分領域確保して、最初/最後をくっつけて

Public Sub TextToRec()
　　Dim rs As New ADODB.Recordset
　　Dim ffn As Integer
　　Dim iNum As Long
　　Dim sR As String, sAry() As String
　　Dim i As Long, iRecCnt As Long
　　Dim sSql As String
　　Const sTable As String = "test1"
　　Const sFile As String = "\abcde.txt"

　　sSql = "DELETE * FROM " & sTable & ";"
　　CurrentProject.Connection.Execute sSql
　　rs.Open sTable, CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic

　　iNum = 1
　　ffn = FreeFile()
　　Open CurrentProject.Path & sFile For Input As #ffn
　　While (Not EOF(ffn))
　　　　Line Input #ffn, sR
　　　　If (Left(sR, 3) = "AAA") Then
　　　　　　Call RecAdd(rs, iNum, Mid(sR, 5))
　　　　Else
　　　　　　iRecCnt = CLng(Split(sR, " ")(1))
　　　　　　ReDim sAry(1 To iRecCnt)
　　　　　　For i = 1 To iRecCnt
　　　　　　　　Line Input #ffn, sAry(i)
　　　　　　Next
　　　　　　Call RecAdd(rs, iNum, sAry(1) & " " & sAry(iRecCnt))
　　　　End If
　　Wend
　　Close #ffn
　　rs.Close
End Sub

Private Sub RecAdd(rs As ADODB.Recordset, iNum As Long, sSrc As String)
　　Dim sAry() As String
　　Dim i As Integer

　　sAry = Split(sSrc, " ")
　　For i = 0 To 2 Step 2
　　　　rs.AddNew
　　　　rs("フィールド1") = sAry(i) & " " & sAry(i + 1)
　　　　rs("連番") = iNum
　　　　rs.Update
　　Next
　　iNum = iNum + 1
End Sub

お礼

回答ありがとうございました。

こんなに早く回答いただけるとは思っておりませんでした。

ご回答頂いた内容を改めて見直して、理解と今後記述ができるように
勉強を進めたいと思います。

でもみなさんどうやってこんな詳しく慣れるんだろうと不思議になるくらいです。

ありがとうございました。

回答No.1

piroin654

http://okwave.jp/qa/q7793788.html
での応用、ということでDAOを使って回答します。
DAOの設定は上記に記しています。

なお、質問ではADOでの内容になっていますが、
条件分岐のところは同じなので、どちらでも
いいのではと思いますが。

一応、質問のようにテキストファイルのデータは、
AAAの場合は数値が4列、BBBはそれ以降に
数値が2列の行が複数出てくる、ということで
回答しています。このことが違っていれば
また、回答は出直しになりますが。
テーブル名は"test"、テキスト名は"テキスト.txt"としています。

以下です。

Sub test20()
　　Dim LineofText As String
　　Dim arrayText As Variant
　　Dim strPath As String
　　Dim i As Long
　　Dim j As Long
　　Dim db As DAO.Database
　　Dim rs As DAO.Recordset

　　Set db = CurrentDb
　　Set rs = db.OpenRecordset("test", dbOpenDynaset)
　　j = 0

　　'テキストファイルを開く
　　Open CurrentProject.Path & "\テキスト.txt" For Input As #1
　　'一行ずつ変数に読み込む
　　Do While Not EOF(1)
　　　　Line Input #1, LineofText
　　　　'配列にデータを格納
　　　　arrayText = Split(LineofText, " ")
　　　　'配列の要素をテーブルに格納
　　　　For i = 0 To UBound(arrayText)

　　　　　　Select Case arrayText(0)

　　　　　　Case "AAA"
　　　　　　　　j = j + 1
　　　　　　　　rs.AddNew
　　　　　　　　rs!フィールド1 = arrayText(1) & " " & arrayText(2)
　　　　　　　　rs!連番 = j
　　　　　　　　rs.Update

　　　　　　　　rs.AddNew
　　　　　　　　rs!フィールド1 = arrayText(3) & " " & arrayText(4)
　　　　　　　　rs!連番 = j
　　　　　　　　rs.Update
　　　　　　　　Erase arrayText
　　　　　　　　Exit For

　　　　　　Case "BBB"
　　　　　　　　Erase arrayText
　　　　　　　　j = j + 1
　　　　　　　　Exit For

　　　　　　Case Else
　　　　　　　　rs.AddNew
　　　　　　　　rs!フィールド1 = arrayText(0) & " " & arrayText(1)
　　　　　　　　rs!連番 = j
　　　　　　　　rs.Update
　　　　　　　　Erase arrayText
　　　　　　　　Exit For

　　　　　　End Select
　　　　Next i
　　Loop
　　Close #1
　　rs.Close: Set rs = Nothing
　　db.Close: Set db = Nothing
End Sub

何かあれば補足していください。

お礼

回答ありがとうございました。

こんなに早く回答いただけるとは思っておりませんでした。

実際に回答頂いた内容で実行してみましたら、希望通りの結果が返ってきました。
ただただ感謝です。

また、ご回答頂いた内容を改めて見直して、理解と今後記述ができるように
勉強を進めたいと思います。

ありがとうございました。