2007年5月11日
【ACCESS】レコードごとのフォルダを作成
職員番号別にフォルダを作成し、その個人情報をそこに保存したい場合は、少なくない。まさか、手入力でフォルダ作成、名前の変更、個人情報をエクセルにエクスポートして、その行をコピーして、テキストファイルにタブ区切りで保存するの？
全職員分ならまだしも、該当者のみとか？該当者は1300人中の900人ですなんて？いやいや、力任せに2連チャンで徹夜してみてもいいんだけど、その翌日に該当者の範囲が変わって1200人になりましたなんていわれた日にはちょっとムカッとくるかも知れません。課長には夕飯を食べる暇があるなら帰れと言われるし。。。（俺に払える残業代はないってことね トホホ）そこで、やっぱり少しだけ頭を使ってバッチ処理（一括処理）を使わざるを得ないんですねぇ。今後はもっと頭を使わないと飲みにも行けなくなくかもなぁ。がんばろっと。
出力するデータ型が列ごとに異なると型エラーが出るので注意が必要だ。
個人番号ごとにフォルダをつくる
Sub makeCsv()Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Dim count As Integer
Dim id As String
Dim csv
rs.Open "qry_kyoudou", cn, adOpenKeyset, adLockOptimistic 'qry_kyoudouクエリを開く
Do Until rs.EOF = True
count = count + 1 '1件目の取り扱い
If id <> rs!個人番号 Then 'IDが個人番号と異なれば、テキストファイルに書き出す処理（グループごとに書き出し）
If count <> 1 Then '1件目でなければ
filename = "c:\test\" & id & "\kyodo_jutaku.txt" 'ｃ直下のID番号と同名のフォルダにkyodo_jutaku.txtを作成
'Debug.Print csv
Open filename For Output As #1 '定型文
Print #1, csv 'データの書き込み
Close #1
csv = "" '変数の初期化
End If
id = rs!個人番号 'レコードの個人番号が前のレコード一緒なら、idにその個人番号を格納→違う個人番号がくるまでデータ
'を変数csvに格納する処理へ（ENDIFのあと）
End If
csv = csv + rs!研究区分 & Chr(9) & rs!研究者名 & Chr(9) & rs!研究者名英語 & Chr(9) & rs!相手先研究機関 & Chr(9) & _
rs!相手先研究機関英語 & Chr(9) & rs!研究テーマ & Chr(9) & rs!研究テーマ英語 & Chr(9) & _
rs!研究開始年度 & Chr(9) & rs!研究終了年度 & Chr(9) & rs!受入金額 & Chr(9) & rs!キーワード & Chr(9) & _
rs!キーワード英語 & Chr(9) & _
rs!科研費分類番号 & Chr(9) & rs!ReaD分類コード1 & Chr(9) & rs!Read分類コード2 & Chr(9) & _
rs!Read分類コード3 & Chr(9) & rs!参考URL & Chr(9) & rs!メモ & Chr(9) & rs!利用範囲 & Chr(13) + Chr(10)
'Chr(9) tab 最後に改行を入れる→Chr(13) + Chr(10)
rs.MoveNext '次の行へ
Loop
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
End Sub
- by editor
- at 08:12
編集長のおすすめの一冊！2010
comments