三流君 ＶＢＡで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー]
[質問/感想 掲示板]
[メルマガ登録/解除]
[VBA系 TOP]
[サイトマップ]
＜シートへデータを転記＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
AccessからExcelにデータを転記してみます。
ただ、転送するだけだとつまらないので
(Docmdで終わってしまうので)
データの分類別にシートを作成して、追加してみたいと思います。
たいした内容じゃないのですが。
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba100.lzh
にdb100.mdb(Access2000版)が保存されています。
おっと、祝100号？だったか？と思いつつ、
2000本安打は通過点です みたいにさらっと流して（笑）
※なんとかつぶされずにここまで来ました。
なんて書いてて、調子こいてたら、つぶされたりしてね（オイオイ）
/*
* １．今回のキッカケ
*/
http://www.ken3.org/cgi-bin/bbs/vba/wforum.cgi
の掲示板に、
>タイトル：ＥＸＣＥＬ出力続き
>最後の挨拶にある・顧客別にシートを作成して、請求明細を複数転記、
>固定の罫線付きのフォーマットに当てはめる
>でやれば尚いいですね、現在の連続出力のやり方で、やるには？？？
----
と書き込みをもらいました。
No.93 Access2000 ADOでクエリーのレコードを参照 Excelへ出力
http://www.ken3.org/backno/backno_vba19.html#93
で、
Private Sub btnTEST_TO_Excel_Click()
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim objEXCEL As Object 'Excel参照用
'Excelを起動する
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
objEXCEL.Visible = True 'Excelを見えるようにする
objEXCEL.Workbooks.Add 'Excelのブックを作成
'レコードセットを開く(Q_顧客情報)
rs.Open "Q_顧客情報", CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
'ループ処理
While rs.EOF = False 'いつものEOFが偽の間
'Excelのシートを追加、シート名を氏名に変更する
objEXCEL.Sheets.Add 'シートを追加する
objEXCEL.ActiveSheet.Name = rs.Fields("氏名") '現在のシート名を変更
'データをセットする(Accessから転記)
objEXCEL.Range("A1") = "番号は"
objEXCEL.Range("B1") = rs.Fields("顧客番号")
objEXCEL.Range("A2") = "ポイントは"
objEXCEL.Range("B2") = rs.Fields("point")
objEXCEL.Range("A3") = "氏名／住所"
objEXCEL.Range("B3") = rs.Fields("氏名")
objEXCEL.Range("B4") = rs.Fields("住所")
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
Wend
'通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
End Sub
と
１レコード、１シートでデータを作成しました。
今回は、同じグループを１つのシートに転記してみます。
/*
* ２．仕様とサンプルデータ
*/
グループかぁ、、、どんなサンプル用意しようかなぁ。
あっ、前回使用したセリーグの規定打席の打撃データがあるよね。
※横浜弱いからマシンガン打線のローズの居たころに差し替えたいけど、
面倒だから前回のデータをそのまま使用しよう。
テーブル名は、T_AVG
フィールドは、
ID
打率順位
選手名
チーム
打率
試合数
打数
得点
安打
二塁打
三塁打
本塁打
打点
三振
四球
死球
犠打
-----
こんな感じです。
順位 選手名 チーム 打率 試合数 打数 得点 安打 二塁打 三塁打 本塁打 ・・・
1 今岡 阪神 0.365 75 318 43 116 28 0 6 ・・・・
2 矢野 阪神 0.352 75 267 46 94 15 4 9 ・・・・
3 赤星 阪神 0.350 75 297 57 104 10 4 0 ・・・・
4 高橋由 巨人 0.350 59 223 47 78 17 1 13 ・・・・
5 ラミレス ヤクルト0.348 75 305 61 106 20 3 24 ・・・・
6 鈴木 ヤクルト 0.336 74 277 45 93 24 0 11 ・・・・
7 福留 中日 0.332 76 289 60 96 19 6 14 ・・・・
8 木村拓 広島 0.330 60 194 24 64 13 0 5 ・・・・
9 シーツ 広島 0.322 69 261 42 84 19 1 11 ・・・・
10 金城 横浜 0.314 73 296 38 93 17 1 7 ・・・・
このデータをチーム別のExcelシートに転記してみたいと思います。
※６つのシートにデータを転記する。
/*
* ３．方法いろいろあるけど、レコードセットを回しながらセットしてみます
*/
方法は、いろいろとあるんだけど（他の方法は、次のネタに取っといて）
今回は、レコードセットを回しながらセットしてみます。
ア．何も考えないで回しまくる
^^^^^^^^^^^^^^^^^^^^^^^^^^^^
まずは、Excelを起動したら、６つの球団別のシートを作らなきゃね。
その後、球団別にデータをセットしていこうよ。
あとは作りながら考え、場当たり的にプログラム組んで行きますか。
まずは、球団別のシートを作成してみました。
Private Sub btnMAKESHEET_Click()
'Excelを起動する
Dim objEXCEL As Object 'Excel参照用
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
objEXCEL.Visible = True 'Excelを見えるようにする
objEXCEL.Workbooks.Add 'Excelのブックを作成
'シートを６つ作成する
Dim strチーム名 As Variant 'チーム名を配列で受け取るタメ
Dim n As Integer 'カウンター変数
strチーム名 = Array("横浜", "阪神", "巨人", "ヤクルト", "中日", "広島")
'チーム名のシートを作成する
For n = 0 To 5 '0〜5までチーム名を取り出しループ
'Excelのシートを追加、シート名をチーム名に変更する
objEXCEL.Sheets.Add 'シートを追加する
objEXCEL.ActiveSheet.Name = strチーム名(n) '現在のシート名を変更
Next n
End Sub
http://www.ken3.org/backno/gif/vba100-01.gif
↑まぁ、順番が逆になったけど、無事６つシートが作成されました。
次は、フィールドのデータを書き込まないとね。
Private Sub btnMAKESHEET_Click()
'Excelを起動する
Dim objEXCEL As Object 'Excel参照用
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
objEXCEL.Visible = True 'Excelを見えるようにする
objEXCEL.Workbooks.Add 'Excelのブックを作成
'シートを６つ作成する
Dim strチーム名 As Variant 'チーム名を配列で受け取るタメ
Dim n As Integer 'カウンター変数
strチーム名 = Array("横浜", "阪神", "巨人", "ヤクルト", "中日", "広島")
'チーム名のシートを作成する
For n = 0 To 5 '0〜5までチーム名を取り出しループ
'Excelのシートを追加、シート名をチーム名に変更する
objEXCEL.Sheets.Add 'シートを追加する
objEXCEL.ActiveSheet.Name = strチーム名(n) '現在のシート名を変更
Next n
'データを転記する
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim strTNAME As String
Dim y As Integer, x As Integer 'セット位置
'レコードセットを開く(テーブルT_AVGを開く)
rs.Open "T_AVG", CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
'ループ処理
While rs.EOF = False 'いつものEOFが偽の間
'Excelのシート、チームをアクティブシートにする
strTNAME = rs.Fields("チーム") 'チーム名を取り出す
objEXCEL.Sheets(strTNAME).Select 'シート名を指定して選択
'データセット位置を探す（馬鹿っぽく（笑））
y = 1
While objEXCEL.Cells(y, 1) <> "" '空白以外の時まわす(空白までループ)
y = y + 1 '次の行にする
Wend
'データをセットする
x = 1
For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする
objEXCEL.Cells(y, x) = rs.Fields(n).Value 'n番目のフィールド値をセット
x = x + 1 '列を＋１する（次の列へ）
Next n
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
Wend
'通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
End Sub
http://www.ken3.org/backno/gif/vba100-02.gif
↑無事データを書き込めました６つの球団別にデータが作成されました。
じゃないでしょ、解説は？解説？
まぁ、アンタの解説聞いてもよくわかんないけど、書いてよ。
ムカっ(AB型の変わり者、右脳と左脳のケンカは置いといて*気にしないでね)
えっと、ポイントは、
~~~~~~~~~~~~~~~~~~~~
'レコードセットを開く(テーブルT_AVGを開く)
rs.Open "T_AVG", CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
で、T_AVGのテーブルを開いてます。
'ループ処理
While rs.EOF = False 'いつものEOFが偽の間
--- ここにレコード転記の処理 ---
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
Wend
で、レコードがなくなるまでループさせます。
まずは、チーム別にシートが分かれているので、
そのチーム別のシートをアクティブにします（選択します）
'Excelのシート、チームをアクティブシートにする
strTNAME = rs.Fields("チーム") 'チーム名を取り出す
objEXCEL.Sheets(strTNAME).Select 'シート名を指定して選択
rs.Fields("チーム")にチーム名が入っているので、変数に保存し、
objEXCEL.Sheets(strTNAME).Select
で、その名前のシートをセレクト（選択）してます。
次に、シートが選択されたら、データを転記したいので、
セットする行（場所）を探します。
'データセット位置を探す（馬鹿っぽく（笑））
y = 1
While objEXCEL.Cells(y, 1) <> "" '空白以外の時まわす(空白までループ)
y = y + 1 '次の行にする
Wend
ここの処理は、Ｙ＝１と一行目にカウンターをセットして、
objEXCEL.Cells(y, 1) <> ""の空白セルを条件にしてループを回し、
ループ内でy=y+1とカウンタ次の行にして、空白セルまでｙをカウントします。
※最初はｙ＝1でループを抜けます。次は1,1にデータがあるので２まで・・
の繰り返しです。
ｙ（行）が求まったので、データをセットします。
'データをセットする
x = 1
For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする
objEXCEL.Cells(y, x) = rs.Fields(n).Value 'n番目のフィールド値をセット
x = x + 1 '列を＋１する（次の列へ）
Next n
ここでは、ｘ（列）のカウンターを１に初期化後、
For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする
と、.Fields.Countでレコードセットのフィールド数を求め−１（０からなので）
までループさせ、
objEXCEL.Cells(y, x)のデータ位置に
rs.Fields(n).Value n番目のフィールドデータをセットしてます。
レコードセットのフィールドへのアクセスは、
rs.Fields("チーム") とフィールド名を使用する方法と
rs.Fields(n) みたいに、ｎ番目と指定する方法があります。
フィールドを全て転記したかったので、
rs.Fields(n)のアクセス方法で回してセットしました。
/*
* ４．チーム別に並べ直してからデータをセットする
*/
サスガ三流プログラマー、工夫のかけらも無いよね。
いいじゃん、動いてんだからさ。
そんなプログラムをもしかして参考にするプログラマーが居たらどうすんの？
世の中に三流プログラマーをこれ以上増やさないでくださいよ。
※だから、調子こいてる・・ＨＰつぶすとか言われるんだよ？（ホントかよ？）
ちぇ、昔やってたキーが変わったら〜、
コントロールブレイクの集計処理じゃないけど
それっぽく作ってみますか。
イ．チーム別にデータを並べ、チーム単位に処理を行う
基本方針を少し変更し、データをまずチーム別にオーダー（select）します
で、チーム単位にシートにそのまま転記してみます。
Private Sub btnMAKESHEET2_Click()
'Excelを起動する
Dim objEXCEL As Object 'Excel参照用
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
objEXCEL.Visible = True 'Excelを見えるようにする
objEXCEL.Workbooks.Add 'Excelのブックを作成
Dim strTNAME As String 'チーム名を管理する
Dim y As Integer, x As Integer 'セット位置
Dim n As Integer 'カウンター変数
'レコードセットを開く(テーブルT_AVGを開く)
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim strSQL As String 'SQL文
'T_AVGテーブルから全ての項目、レコードの順はチーム,打率順位とする
strSQL = "Select * From T_AVG Order BY チーム, 打率順位"
rs.Open strSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
'ループ処理
strTNAME = "横浜大洋ホエールズ" '一致しない値で初期化（笑）
While rs.EOF = False 'いつものEOFが偽の間
'チームが変わったかをチェックする
If strTNAME <> rs.Fields("チーム") Then 'チーム名を比べる
strTNAME = rs.Fields("チーム") '変わったチーム名をセットする
'Excelのシートを追加、シート名をチーム名に変更する
objEXCEL.Sheets.Add 'シートを追加する
objEXCEL.ActiveSheet.Name = strTNAME '現在のシートをチーム名に変更
'おまけで先頭行にフィールド名をセット
y = 1 '行カウンタを先頭行にする
x = 1
For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする
objEXCEL.Cells(y, x) = rs.Fields(n).Name 'n番目field名をセット
x = x + 1 '列を＋１する（次の列へ）
Next n
End If
'データセット位置を次の行にする
y = y + 1 '次の行にする
'データをセットする レコード -- シートへ転記
x = 1
For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする
objEXCEL.Cells(y, x) = rs.Fields(n).Value 'n番目Field値をセット
x = x + 1 '列を＋１する（次の列へ）
Next n
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
Wend
'通常は、ここでExcelを保存するんだけど、今回は開きっぱなしの手抜き
rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって?
End Sub
処理のポイントは、
^^^^^^^^^^^^^^^^^^
'Excelを起動する
Dim objEXCEL As Object 'Excel参照用
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクトの作成
objEXCEL.Visible = True 'Excelを見えるようにする
objEXCEL.Workbooks.Add 'Excelのブックを作成
の起動部分は、一緒ですが、ここから先が一味違う。
'レコードセットを開く(テーブルT_AVGを開く)
Dim rs As New ADODB.Recordset 'ADOのレコードセット
Dim strSQL As String 'SQL文
'T_AVGテーブルから全ての項目、レコードの順はチーム,打率順位とする
strSQL = "Select * From T_AVG Order BY チーム, 打率順位"
rs.Open strSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic
データの取り方をT_AVGテーブル直接から、
SQL文で、
Select * From T_AVG Order BY チーム, 打率順位
と、データを並べなおしてチーム, 打率順位によこせよとオーダーします。
データの順番が、チーム別の順番になっているので、
チーム単位の転記、シート単位で転記する処理を狙っています。
ループ処理では、まず初期化処理で、
strTNAME = "横浜大洋ホエールズ" '一致しない値で初期化（笑）
と、チーム名を管理する変数に、一致しない値を代入します。
シャレで、横浜大洋ホエールズと今実在しないチーム名を入れてますが、
strTNAME = ""がキレイな作り方です。この初期化の狙いは、
'チームが変わったかをチェックする
If strTNAME <> rs.Fields("チーム") Then 'チーム名を比べる
ここで、初回にstrTNAME = "横浜大洋ホエールズ"とフィールドのチームを比べるので、
<>の不一致のIf文にかかります。
strTNAME = rs.Fields("チーム") '変わったチーム名をセットする
で、まず、チーム名を代入してます。
次は、チーム名が変わったので、そのチーム向けのシートを作らなきゃ
'Excelのシートを追加、シート名をチーム名に変更する
objEXCEL.Sheets.Add 'シートを追加する
objEXCEL.ActiveSheet.Name = strTNAME '現在のシート名をチーム名に変更
と、.Sheets.Add , ActiveSheet.Name を使用してチーム名のシートが出来上がる。
'おまけで先頭行にフィールド名をセット
y = 1 '行カウンタを先頭行にする
x = 1
For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする
objEXCEL.Cells(y, x) = rs.Fields(n).Name 'n番目のフィールド名をセット
x = x + 1 '列を＋１する（次の列へ）
Next n
おまけだけど、シートを追加したので、
先頭行にrs.Fields(n).Nameと.Nameフィールド名を表示させてます。
End If
上記で、チーム名が変わったら、
シートを追加、名前の変更、先頭行にフィールド名
の初期処理を行ってます、
アクティブシートは追加したシートになっているので、切り替える必要は無く、
データのセット位置も先頭行からなので、探す必要が無いです。
'データセット位置を次の行にする
y = y + 1 '次の行にする
なので、↑のように、そのまま、セット位置を＋１（次にしてます。）
チームが変わった時、Y=1先頭行と初期化されているので、２となります。
チームが変わらなければ、アクティブシートもそのまま、Y位置が+1され、
データセットする位置が次行に変わる、そんな仕組みです。
'データをセットする レコード -- シートへ転記
x = 1
For n = 0 To rs.Fields.Count - 1 'フィールドの数分ループする
objEXCEL.Cells(y, x) = rs.Fields(n).Value 'n番目のフィールド値をセット
x = x + 1 '列を＋１する（次の列へ）
Next n
上記は、そのままレコードをシートに転記してます。
rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑)
で、次のレコードに移動し、
Wend
ループの頭に戻り、EOFのチェック。
その後、また、チームが変わったかを１レコード単位でチェックしながら、
データの転記処理を行います。
これが昔の先輩がたまに口にする、
コントロールブレーク処理 や キーが変わったタイミングで処理しろ
って感じの言葉です。
※人によってループの作り方、まだまだイロイロとクセや工夫があるんだけど。
※今の会社の教育体制に疑問を感じた、ボーナス少なかった・・なんて人は、
匿名で自分の価値を下記で探ってみては？
まぁ、辞めても地獄、残っても飼い殺しかもしれないけど・・・
-【けんぞう！】---------------------------------------------------------
転職関係、在宅プログラマー、SOHOの広告まとめました、匿名で職探せます。
http://www.ken3.org/etc/500yen/zaitaku.html いろいろとあるので転機の人はぜひ
『だだ、広告料稼ぎたいだけだろ、紹介料300円〜1000円の小金稼ぎ』
ギクっ、、、バレた（笑）登録料無料、匿名で探せるので在宅で小金稼ぎの人も見てね
------------------------------------------------------------------------
※ボーナス後なのか、登録件数月末から４件もあった・・・
残るのも選択肢の一つと考えつつ、探してみてください。
出て行ってもいいことあるかもしれないし、無いかもしれないよ・・・
/*
* ５．終わりの挨拶
*/
今回は、
横浜大洋ホエールズで変数を初期化する
って話でした。
オイオイ、違うだろ、
今回は、
グループ別のデータをシートに転記するサンプルでした。
無条件にループさせてデータをセットする方法
と
並べ直してから、グループ単位に処理する。
そんなサンプルを書いてみました。
昔のCOBOLの教科書、そんなレコード処理（ソート後にキーによって）
が載っているので、言語わからなくても一度見てみると、面白いですよ。
※Accessから、やってると、集計処理に=Sumとか、
レポートにグループ化なんてあって、とても便利なので(楽しているので)、
自分でちょっと集計すればできるのに(少し工夫すればできるのに)、
Accessレポートではできません・・とすぐにギブアップで白旗降参するボウヤ達。
仕様書書いてるCOBOLのおじちゃん達は怒っちゃうよ、キット。
そんな集計処理も作れないのかAccess世代は・・・とか・・・
（＊Accessから入った、できる若者プログラマーも多いので、決め付けないでね）
※みんながみんな、VBAのプログラム作成を目指さなくってもねぇ。
Access集計簡単でいいんじゃないの？
プロや複雑な集計したい人だけVBAでレコードセット作って、
自分でループさせるので。
アンマ、Access USERを怒らせるなよ三流のクセに・・・
なんて、怒られそうなので、このへんで。
(AB型の変わり者作者の右脳と左脳がケンカは置いといて*気にしないでね)
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba100.lzh
にdb100.mdb(Access2000版)が保存されています。
実際にイタズラしてみてください。
独り言は置いといて、何かの参考となれば幸いです。
~~~~~~~~~~~~~~~~~~
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜Outlookの重要度フラグ .Importance = olImportanceHigh＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
Outlookで重要度のフラグを探ったお話です。
※探し方がヘタでした（笑）
たいした内容じゃないのですが。
/*
* １．今回のキッカケ
*/
http://www.ken3.org/cgi-bin/bbs/vba/wforum.cgi
の掲示板に、
> Outlookのメール操作の中で、
> メールの送信は出来るのですが、
> その送信メールの「重要度フラグ」をプログラム（VB）で操作することは
> 可能なのでしょうか??
----
と書き込みをもらいました。
重要度のフラグ、少し興味あったので、探ってみました。
/*
* ２．いつもの探り方(失敗したけど、参考になればと思い)
*/
Outlookを起動します。
起動後、Alt+F11を押します。
すると、ＶＢＡのいつものよく見かける画面が表示されます。
ここで、適当な変数を定義します。
Dim aa as MailItem
と、メールのアイテム型の変数を定義します。
あとは、いつものように、aa.とピリオドを打つと、
プロパティやメソッドが表示されるので、
それらしいプロパティ・メソッドの名称を選択します。
おっ、と思ったのが、
の、
.FlagStatus フラグのステータス
これでしょうと確認もしないで、決め付けて、メルマガ向け画面コピーも行う。
※オイオイ気がハヤイって、、、
プロパティにカーソルを合わせ、F1のヘルプを見る。
あれれ・・・重要度のフラグじゃないみたいです。。。
ハズシタ（笑）
探り方、外したけど、こんな感じで、
該当するオブジェクト型の変数を定義
Dim aa as MailItem
その後、
aa.
と、候補を表示させ、それらしいのにアタック。
aa.FlagStatus と選択後、カーソルを合わせてからF1のヘルプを見る。
そんな流れでいつもプロパティ、メソッドを探ってます。
/*
* ３．ネットを検索する
*/
いまだに、うまいキーワードで検索できないけど、
ネットで検索して、サンプルを拾ってきて、自分のものにする方法もあります。
MailITEM 重要度 の２つのキーワードで検索すると、下記のページがヒットする。
^^^^^^^^^^^^^^^
http://www.microsoft.com/japan/msdn/library/ja/modcore/html/deovrworkingwithoutlookfoldersitems.asp
>Restrict メソッドを使用する場合、角かっこで囲んだ Outlook フィールド名を使用
>して検索の抽出条件を指定します。And、Or、Not などの演算子を使用して複数の抽出
>条件を結合できます。たとえば、次のサンプルでは、過去 7 日間内に送信された、
>重要度の高い未読メール アイテムを検出します。
>
>Dim fldMail As Outlook.MAPIFolder
>Dim itmItems As Outlook.Items
>
>strCriteria = "[SentOn] > '" & (Date - 7) _
> & "' And [UnRead] = True And [Importance] = High"
>
>Set fldMail = gnspNameSpace.GetDefaultFolder(olFolderInbox)
>Set itmItems = fldMail.Items.Restrict(strCriteria)
このサンプルって、
今あるメッセージの検索ぽいので却下(笑)、たぶん受信済み未読を検索すると思う
でも、ここから、
[Importance] = High"
が怪しいとにらみ、これだろとまた勝手に思い込む（笑）
Importance プロパティをヘルプで探る。
~~~~~~~~~~~~~~~~~~~~~
>Outlook アイテムの相対的な重要度を表す OlImportance クラスの定数を
>設定します。このプロパティは、MAPI プロパティの
>PR_IMPORTANCE に対応しています。値の取得および設定が可能です。
>
>使用できる定数は、次に示す OlImportance クラスの定数のいずれかです。
>olImportanceHigh
>olImportanceLow
>olImportanceNormal
>
>expression.Importance
>
>expression 必ず指定します。対象となるオブジェクトへの参照を表すオブ
>ジェクト式を指定します。
と、やっと目的のプロパティにたどり着いたみたいです。
Sub aaa()
Dim myOlApp As Outlook.Application
Dim myitem As MailItem
Set myOlApp = CreateObject("Outlook.Application")
Set myitem = myOlApp.CreateItem(olMailItem)
myitem.To = "test@ken3.org"
myitem.Body = "test"
myitem.Importance = olImportanceHigh
myitem.Display
End Sub |
.Importance = olImportanceHigh が、重要度 高みたいです。
試してみてください。
/*
* ４．ExcelからいつものCreateObjectだと定数が参照できない
*/
参照設定が正しくされていると、
みたいに、定数の候補が出て、コーディングもしやすいです。
Outlook2000,Outlook2002と環境を行ったりきたりするので、
参照設定をしてない場合は、
olImportanceHigh など、定数が使えません（エラーが発生します）
まぁ、そんな時は、OutlookのＶＢＡ編集画面で、
? olImportanceHigh
2
? olImportanceLow
0
? olImportanceNormal
1
なんてやって、定数を求めて、
objMAIL.Importance = 2 'olImportanceHigh=2
みたいに直値で書くか、
Const olImportanceHigh = 2 '重要度=高
と、自分でConst定義するか・・・
Excel VBAで、参照設定無しで重要度(高)のメールを作成するサンプル。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'メールアイテム作成後、重要度を高olImportanceHigh=2にする
objMAIL.Importance = 2 'olImportanceHigh=2
と、メールアイテムのオブジェクトに対して重要度を２(高)に設定してます。
Sub test送信メール作成()
Dim oApp As Object 'アプリケーションオブジェクト
Dim objMAIL As Object 'メールのオブジェクト
Dim strMOJI As String '本文
'アプリケーションオブジェクトの作成
Set oApp = CreateObject("Outlook.Application")
Set objMAIL = oApp.CreateItem(0) 'olMailItem=0
'メールアイテム作成後、重要度を高olImportanceHigh=2にする
objMAIL.Importance = 2 'olImportanceHigh=2
strMOJI = "こんにちは" & vbCrLf _
& "プログラマーの愚痴、教えまっせ？" & vbCrLf _
& "http://www.ken3.org/ よろしく（笑）"
objMAIL.To = "test@ken3.org" '宛先
objMAIL.Subject = "未承諾広告※（笑）" '件名
objMAIL.Body = strMOJI '本文の代入
objMAIL.Display '途中で編集したい時（メール表示してみた)
'おまけでＯｕｔｌｏｏｋ表示
Dim myNameSpace As Object
Dim myFolder As Object
Set myNameSpace = oApp.GetNameSpace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダーを指定
myFolder.Display '表示
End Sub |
できたら、直値で作成するよりも、
参照設定をして、キチント作った方がいいです。
あと、社内のＯｆｆｉｃｅのバージョンもそろっていたほうが、なにかと楽かなぁ。
まぁ、世の中、混在環境や様々なマシーン構成があるので、
メルマガサンプルで私が参照設定を避けたがるみたいに、
いつもAs Objectでやるのも手だけど、あまりお薦めは出来ません。
Set objMAIL = oApp.CreateItem(0)
objMAIL.Importance = 2
とか、書かれても、あとで見ると？マークになってしまう。
Set objMAIL = oApp.CreateItem(0) 'olMailItem=0
'メールアイテム作成後、重要度を高olImportanceHigh=2にする
objMAIL.Importance = 2 'olImportanceHigh=2
と私はコメントでかわしているが、、、、
---- ここから 下、宣伝です ----
※今の会社の教育体制に疑問を感じた、ボーナス少なかった・・なんて人は、
匿名で自分の価値を下記で探ってみては？
まぁ、辞めても地獄、残っても飼い殺しかもしれないけど・・・
-【けんぞう！】---------------------------------------------------------
転職関係、在宅プログラマー、SOHOの広告まとめました、匿名で職探せます。
http://www.ken3.org/etc/500yen/zaitaku.html いろいろとあるので転機の人はぜひ
『だだ、広告料稼ぎたいだけだろ、紹介料300円〜1000円の小金稼ぎ』
ギクっ、、、バレた（笑）登録料無料、匿名で探せるので在宅で小金稼ぎの人も見てね
------------------------------------------------------------------------
※ボーナス後なのか、登録件数月末から４件もあった・・・
残るのも選択肢の一つと考えつつ、探してみてください。
出て行ってもいいことあるかもしれないし、無いかもしれないよ・・・
/*
* ５．終わりの挨拶
*/
今回は、
Outlookのメール重要度を探った話でした。
独り言は置いといて/独り言も含め、何かの参考となれば幸いです。
~~~~~~~~~~~~~~~~~~
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜Excel 範囲を選択して、カンマ区切りのファイルを作る＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
Excelで範囲を選択して、カンマ区切りのファイルを作ってみたいと思います。
たいした内容じゃないのですが。
http://www.ken3.org/p/f/lzh/office-019.lzh
に今回のサンプル保存されてます。
あわせてみてください。
/*
* １．プログラムは流用と新機能の作成？
*/
Excel範囲をHTMLのテキストファイルにするプログラムを作成ました。
詳細は、
http://www.ken3.org/backno/backno_vba17.html
の
[No.80 Excelのセル範囲をHTMLの表(.html)にしてみる]
[No.81 セルの右寄せ、中央寄せをHTMLの表にしてみる]
[No.82 背景色、フォントカラーをHTMLの表にしてみる]
[No.83 改行LFを<BR>などHtml用にエンコードして書き込む]
を見てください。
なんていつもの過去マガの宣伝は置いといて、
今回は、HTML部分をCSVの出力に変えて、作ってみたいと思います。
まずは、流用して、工夫も無しに出力してみました。
Sub Main()
'Application.InputBoxでセルを選択させる
Dim objTARGET As Range '選択されたセルの集合
Set objTARGET = Application.InputBox(prompt:="セルを選択", Type:=8)
If IsEmpty(objTARGET) Then 'キャンセルが押されたかチェックする
MsgBox "キャンセルが押されました"
Exit Sub
End If
'ファイル名を作成 ファイル名は自分のパス+\test.html
Dim strFNAME As String 'ファイル名保存用
strFNAME = ThisWorkbook.Path & "\test.csv" 'ファイル名を作る
'テーブルデータを作成する
Call MAKE_CSV_FILE(strFNAME, objTARGET)
'できたファイルをメモ帳で表示して確認する
Shell "notepad.exe " & strFNAME '手抜きでShellで起動
'終わりの挨拶
MsgBox strFNAME & "を作成しました"
End Sub |
'ファイル名とセルの範囲RANGEを受け取り、
'ファイルを開きカンマ区切りのファイルを作成する
Sub MAKE_CSV_FILE(strFNAME As String, objHANI As Range)
'ファイルをオープンする
Dim FNO As Integer 'ファイル番号
FNO = FreeFile '空いてるファイル番号を取出す
Open strFNAME For Output As #FNO 'テキストファイルを新規作成
'行、列でループを作る
Dim y As Integer
Dim x As Integer
For y = 1 To objHANI.Rows.Count '行のループ
For x = 1 To objHANI.Columns.Count '列のループ
Print #FNO, objHANI.Cells(y, x).Value;
Print #FNO, ",";
Next x
Print #FNO, "" '改行のみ出力
Next y
'ファイルをクローズする
Close #FNO
End Sub |
ファイルを開いて、何も考えないで出力してみました。
ポイントは、
~~~~~~~~~~~~
For y = 1 To objHANI.Rows.Count '行のループ
For x = 1 To objHANI.Columns.Count '列のループ
Print #FNO, objHANI.Cells(y, x).Value;
Print #FNO, ",";
Next x
Print #FNO, "" '改行のみ出力
Next y
で、セルの範囲をループさせて、
.Valueをそのまま出力してます。
/*
* ２．実行テスト
*/
プログラムが完成したら、テスト、不具合修正、またテスト・・
といった作業になるのかなぁ。
データを用意して、テストしてみました。
日付 単価 数量 合計金額 備考
2003/6/7 22:34 10 5 50.0 文字列は、、、
2003年6月7日 12.5 5 62.5 文字列は、、、
平成15年6月7日 25.5 1.15 29.3 文字列は、、、
H15.6.7 750 1.3 975.0 文字列は、、、
合計は表示形式で小数点以下１位まで。
日付は=Now()関数と表示形式を変えてます。
上記の表を変換してみました。
すると、変換結果は、
日付,単価,数量,合計金額,備考,
2003/06/07 22:34:14 , 10 , 5 , 50 ,文字列は、、、,
2003/06/07 22:34:14 , 12.5 , 5 , 62.5 ,文字列は、、、,
2003/06/07 22:34:14 , 25.5 , 1.15 , 29.325 ,文字列は、、、,
2003/06/07 22:34:14 , 750 , 1.3 , 975 ,文字列は、、、,
でした。
う〜ん、一工夫必要ですね。
^^^^^^^^^^^^^^^^^^^^^^^^^^
まず、気になるのは、実害は無いかもしれないが、
カンマが１つ多く出力されている（行最後のカンマ）
日付,単価,数量,合計金額,備考,←の最後の改行前のカンマ
これは、
For x = 1 To objHANI.Columns.Count '列のループ
Print #FNO, objHANI.Cells(y, x).Value;
Print #FNO, ",";
Next x
データ出力 Print #FNO, objHANI.Cells(y, x).Value;
カンマを出力 Print #FNO, ",";
とペアで出力しているからです。
これを、値の前にカンマを出力すように変更してみます。
For x = 1 To objHANI.Columns.Count '列のループ
Print #FNO, ",";
Print #FNO, objHANI.Cells(y, x).Value;
Next x
これだけだと、今度は、先頭にカンマが付く（笑）
,日付,単価,数量,合計金額,備考
カンマを出力してからデータを書いてるので、あたりまえか。。。
なので、もう一工夫、
For y = 1 To objHANI.Rows.Count '行のループ
Print #FNO, objHANI.Cells(y, 1).Value; '先頭項目の出力
For x = 2 To objHANI.Columns.Count '列のループ
Print #FNO, ",";
Print #FNO, objHANI.Cells(y, x).Value;
Next x
Print #FNO, "" '改行のみ出力
Next y
と、先頭項目を出力後、カウンタを２からスタート、
カンマを出力後、データを出してみました。
※小細工だけどね。
'ファイル名とセルの範囲RANGEを受け取り、
'ファイルを開きカンマ区切りのファイルを作成する
Sub MAKE_CSV_FILE(strFNAME As String, objHANI As Range)
'ファイルをオープンする
Dim FNO As Integer 'ファイル番号
FNO = FreeFile '空いてるファイル番号を取出す
Open strFNAME For Output As #FNO 'テキストファイルを新規作成
'行、列でループを作る
Dim y As Integer
Dim x As Integer
For y = 1 To objHANI.Rows.Count '行のループ
Print #FNO, objHANI.Cells(y, 1).Value; '先頭項目の出力
For x = 2 To objHANI.Columns.Count '列のループ
Print #FNO, ",";
Print #FNO, objHANI.Cells(y, x).Value;
Next x
Print #FNO, "" '改行のみ出力
Next y
'ファイルをクローズする
Close #FNO
End Sub |
/*
* ３．.Value , .Value2 , .Text
*/
現在、.Valueで出力してます。
これを表示形式通りで出力できないか？（画面の見た目通り）と思い、
いろいろと見てみると、おっ、.Value2ってあるじゃん。
これ試してみよう。
↑プロパティの選択画面※ここから冒険して探すのも一つの手です。
? range("b3").Value
2003/06/07 22:34:14
? range("b3").Value2
37779.9404351852
あらら、期待ハズレか、、、
おっ、.Textってのがある、これを試してみると、
? range("b3").Text
2003/6/7 22:34
? range("b4").Text
2003年6月7日
? range("b5").Text
平成15年6月7日
と、表示形式が効いて、出力されます。
※場合によっては、使い分けてみたいですよね。
今回みたいに、プログラムに組み込む前に
イミディエイト ウインドウ
で
関数やプロパティのテストをすると、簡単でいいですよ。
? Len(a) とか関数の実行できるので便利です。
(詳細解説は、 http://www.ken3.org/vba/iwind.html 参照 )
-【けんぞう！】---------------------------------------------------------
三流君の、小金稼ぎ、お小遣い稼ぎシリーズ第３弾（稼げないだろコラ！！）
参加無料：予想が当たれば一攫千金？今月はプロ野球のセパ勝敗とホームラン数
http://www.ken3.org/etc/500yen/5050.html ← 100万を当たった人数で山分け
『チッ、大穴横浜の勝利に賭けてるのに当たらない（笑）』（横浜ファン：31歳）
------------------------------------------------------------------------
/*
* ４．終わりの挨拶
*/
今回は、
選択範囲をカンマ区切りのCSVファイルにしてみました。
カンマの隣に空白が出力されて、まだまだ使えないルーチンだけどね。
.Value , .Value2 , .Text
似てるけど、少し違うので、みなさんも、探ってみてください。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜あるファイルから指定した行数分データを抜き出す＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
掲示板にあった質問、
>タイトル：csvファイルの指定した行の表示
で、
Dir関数、あとはファイルの空読みをやってみます。
たいした解説、回答内容じゃないのですが。
/*
* １．今回のキッカケ
*/
ＶＢＡ系の掲示板
http://www.ken3.org/cgi-bin/bbs/vba/wforum.cgi
で、下記の質問をもらいました。
----
>タイトル：csvファイルの指定した行の表示
>
>ホルダーの中にあるＣＳＶファイルで特定のファイルすべての特定の行（数行）だけをエクセルのＢＯＯＫに一覧表示したい。
>10001001.1
>10001001.2
>10001001.3
>10001001.dat
> .
> .
> .
>上記のようなファイルで．datと付いたファイルすべての指定した行のみを
>ファイルごとに一覧にしたいと思っていますが、出来るのでしょうか？
----
さてと、
該当ファイル名の規則は、*.dat
あとは、特定の行を抜き出すのかぁ。
/*
* ２．調べごと、下準備
*/
まずは、該当ファイルを取り出さないとね。
Sub FileChk_test()
Const strCHKPATH = "E:\Work\" 'データの保管場所
Dim strFILENAME As String 'ファイル名格納用
strFILENAME = Dir(strCHKPATH & "*.dat") 'ファイルのパスとパターンを渡す
While strFILENAME <> "" '空文字以外の間ループする
MsgBox "取り出したファイル名[" & strFILENAME & "]"
strFILENAME = Dir() '引数無しでDir関数を呼び出すと次のファイル名を返す
Wend
End Sub |
と、Dir関数を使用して、該当データファイルを選別してみました。
ポイントは、
Dir(strCHKPATH & "*.dat")
と、ワイルドカード付きでDir関数を呼ぶと、該当ファイル名を返します。
見つからない場合は""と空文字列を返してくれます。
引数無しで再度Dir関数を呼ぶと、次のファイル名を返してくれます。
で、無くなった時は、""と空白文字列を返します。
それを利用して、ループを作成してます。
No.3 Dir関数でファイルの存在をチェックする
http://www.ken3.org/backno/backno_vba01.html#3
で作っている、ファイルリストの処理も参考にしてみてください。
次は、行を飛ばして、データを読まないとね。
Sub READ_DATA_TEST()
Dim nFILENO As Integer 'ファイル番号
Dim strInFileName As String '入力ファイル名
Dim strBUFF As String 'レコードを読みこむバッファ
Dim n As Integer 'カウンター変数
strInFileName = "e:\work\0001.dat" 'ファイル名を作る今は固定値だけど
'ファイルの存在チェック
If Dir(strInFileName) = "" Then
MsgBox strInFileName & "が見つかりません"
Exit Sub
End If
'ファイルを入力モードで開く
nFILENO = FreeFile() '空いているフィル番号を取り出す
Open strInFileName For Input As #nFILENO 'ファイルを入力モードで開く
'空読みする（行を読み飛ばす）
For n = 1 To 4 'テストで４行読み飛ばす
Line Input #nFILENO, strBUFF '読み込むが何もしない
Next n
'数行読み込む
For n = 1 To 3 'テストで３行読み込む
Line Input #nFILENO, strBUFF 'バッファに読み込む
MsgBox "読み込んだデータ" & strBUFF
Next n
'ファイルは閉じようね
Close #nFILENO
End Sub |
ただ、単に、
'空読みする（行を読み飛ばす）
For n = 1 To 4 'テストで４行読み飛ばす
Line Input #nFILENO, strBUFF '読み込むが何もしない
Next n
と、
空読みして飛ばした、ただけでした（笑）
No.29 テキストファイル処理 ファイルからの読み込み
http://www.ken3.org/backno/backno_vba06.html#29
で、テキストファイルの読み込み系、
No.33 FreeFile関数で空いてるファイル番号を返す方法
http://www.ken3.org/backno/backno_vba07.html#33
で、空いてるファイル番号を使う理由
上記２つも、あわせてみてください。
/*
* ３．関数を組み合わせる(上位と下位の関数をまとめる)
*/
Sub FileChk_test()
Const strCHKPATH = "E:\Work\" 'データの保管場所
Dim strFILENAME As String 'ファイル名格納用
strFILENAME = Dir(strCHKPATH & "*.dat") 'ファイルのパスとパターンを渡す
While strFILENAME <> "" '空文字以外の間ループする
MsgBox "取り出したファイル名[" & strFILENAME & "]"
strFILENAME = Dir() '引数無しでDir関数を呼び出すと次のファイル名を返す
Wend
End Sub |
で
ファイル名のループは出来ました。
テストプログラムで固定値だったけど、
e:\work\0001.dat
から
４行読み飛ばして３行読み込めました。
必要なのは、
読み込むファイル名
読み込み開始行
読み込む行数
読み込み結果の格納場所ですね。
関数名 READ_DATA(strInFileName As String, _
nSTART As Integer, _
nREADCNT As Integer, _
strREADBUFF() As String)
として、入力ファイル名strInFileNameと
読み込み開始行nSTART,読み込む行数nREADCNT
データの格納先、strREADBUFFの文字列型の配列
をパラメータで受け取り、データをセットする関数を作ります。
（関数にします）
※ここから下２つで、目的の処理を実行してます。
Sub Main_test()
Const strCHKPATH = "E:\Work\" 'データの保管場所
Dim strFILENAME As String 'ファイル名格納用
Dim strBOX(3) As String 'データを格納するバッファ
strFILENAME = Dir(strCHKPATH & "*.dat") 'ファイルのパスとパターンを渡す
While strFILENAME <> "" '空文字以外の間ループする
'データを読み込むサブ関数を呼ぶ 5行目から3行読む
Call READ_DATA(strCHKPATH & strFILENAME, 5, 3, strBOX())
'strBOXにデータが読み込まれているので、それを利用した処理を書く
MsgBox "strbox(0)" & strBOX(0)
MsgBox "strbox(1)" & strBOX(1)
MsgBox "strbox(2)" & strBOX(2)
'次のファイル名を取り出す
strFILENAME = Dir() '引数無しでDir関数を呼び出すと次のファイル名を返す
Wend
MsgBox "処理終了"
End Sub |
メインのルーチンでは、
該当ファイル名でループさせます。
ループの中で、データの読み込み関数を呼び、データを配列に保存、
その配列を使用した処理を書き、
次のファイル名に移る。
データ読み込み、セット側では、
ファイルを開き、
データの頭だし（空読みして、行を飛ばす）
必要数分データを読み込み、配列にセット。
ファイルを閉じる。
Sub READ_DATA(strInFileName As String, _
nSTART As Integer, _
nREADCNT As Integer, _
strREADBUFF() As String)
Dim strBUFF As String 'データ読み込み用のバッファ
Dim nFILENO As Integer 'ファイル番号
Dim n As Integer 'カウンター変数
Dim nSETCNT As Integer
'ファイルを入力モードで開く
nFILENO = FreeFile() '空いているフィル番号を取り出す
Open strInFileName For Input As #nFILENO 'ファイルを入力モードで開く
'空読みする（行を読み飛ばす）
For n = 1 To nSTART - 1 '開始行数の１つ前まで空読みする
If EOF(nFILENO) = True Then Exit For '途中でファイルが終わっていたか？
Line Input #nFILENO, strBUFF '読み込むが何もしない
Next n
'数行分読み込み、バッファにセットする
nSETCNT = 0
For n = 1 To nREADCNT '読み込み行数分ループで読み込む
If EOF(nFILENO) = True Then Exit For '途中でファイルが終わっていたか？
Line Input #nFILENO, strBUFF 'バッファに読み込む
strREADBUFF(nSETCNT) = strBUFF 'データをn番目にセット
nSETCNT = nSETCNT + 1 'セット位置を＋１する
Next n
'ファイルは閉じようね
Close #nFILENO
End Sub |
といった、２構成に分けてみました。
-【けんぞう！】---------------------------------------------------------
月500円、タバコなら２箱、120円缶コーヒーなら４缶分の謝礼をＧｅｔするなら
http://www.ken3.org/etc/500yen/ ←無料アンケート系の広告です。
『チッ、がんばって回答して月500円かよ』（お馬鹿なプログラマー：30歳）
------------------------------------------------------------------------
/*
* ４．終わりの挨拶
*/
今回は、
指定ファイルから指定行数抜き出して処理してみました。
カッコよくて面白い人を探せ・・（かわいくて、素直な子を探せ）
と一度に考えると、大変なので、
まずは、指定ファイルの処理をテストして、次に指定行数の抜き出し、
その二つを引数で必要なデータを渡し、つなげてみました。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜Access DAO Recordset = Me.RecordsetClone＞
どうも、三流プログラマーのＫｅｎ３です。
今回は、
Access97で、フォームのレコードセット複製を使って、遊んでみたいと思います。
たいした解説、回答内容じゃないのですが。
/*
* １．今回のキッカケ
*/
ＶＢＡ系の掲示板
http://www.ken3.org/cgi-bin/bbs/vba/wforum.cgi
で、下記の質問をもらいました。
----
>>Access97だと、レコードセットを直接、
>>フォームの元に出来ないので（出来ないと思います）
>
>やはり、駄目でしたか。
>どうしてもAccess９７の環境で動かす必要があるのですが、対応していないので
>あれば仕方がないです。
>
>>何らかの事情があって、
>>Me.RecordSourceにセットしていないとは思いますが。
>
>このような仕組みを考えたのは、元になるクエリーが重くて、せっかく開いたク
>エリーの結果をExcelの作成にそのまま使いたかったからです。
>今動かしているのは、フォーム上にExcelのボタンがあり、そこからExcelに吐き
>出すために再度同じクエリーを動かしています。
>Accessのフォーム用とExcelのシート用と、同じ結果を出すために一つのクエリ
>ーを二回動かしているイメージです。
>そこでレコードセットにすることで、一回のクエリーの結果で二つのフォーム
>とシートに出力できないものかと考えました。
>もっとスマートな方法がありそうなのですが、知識がなくて先に進めません。
>もし何らかのヒントでもあればアドバイスしていただければ助かります
----
やりたいことは、重たいクエリーを２回走らせたくないかぁ。
/*
* ２．調べごと、下準備
*/
フォームに表示しているデータを取れないかなぁ・・・と探すと。
.RecordsetCloneなんてのが見つかる。
ヘルプを見ると、
>フォームの "RecordSource/レコードソース" プロパティに設定されている
>テーブルまたはクエリの Recordset オブジェクトを参照します。
となっています。
下記、Access97でテストした結果。
Private Sub コマンド8_Click()
Dim rs As Recordset 'フォームのレコードセットのクローンをもらう
Set rs = Me.RecordsetClone 'レコードセットのクローンを代入
MsgBox rs.RecordCount
End Sub |
Dim rs As Recordsetとレコードセットの変数を定義して、
Set rs = Me.RecordsetClone
で複製を代入。
あとは、普通のレコードセット同様に使用可能です。
MsgBox rs.RecordCount
とテストでは、レコード数を表示しましたたが。
※ある意味、フォームデータのソートやフィルターとかも効くし
便利です。
これができるなら、Me.Recordsetってあってもいいと思うのに、
Access97では、出てこなかった。
※いまファミレスやフォースとフードで流行っている
裏メニューって感じで裏プロパティがあるのかなぁ・・う〜ん。
クローンで複製作れるなら、そのままセットできてもと思うが、
Access97は、Me.RecordSourceで切り替えみたいです。
Access2000でＤＡＯ関係を使用するには、DAOの参照設定を行い。
Dim rs As DAO.Recordset
とDAO.のレコードセットですよと変数宣言で書く。
Private Sub コマンド40_Click()
'Access2000の場合、DAOの参照設定を入れて使用する
Dim rs As DAO.Recordset 'フォームのレコードセットのクローンをもらう
Set rs = Me.RecordsetClone 'レコードセットのクローンを代入
MsgBox rs.RecordCount
End Sub |
/*
* ３．関数を組み合わせる(組み込む)
*/
やりたいことは、重たいクエリーを２回使いたくない、
なので、フォームのレコードソースを重たいクエリーにして表示する。
Excel出力のボタンが押されたら、
フォームで操作中のレコードセットの複製を作成して、
Excelのデータを作成する。
って、感じの流れで作業してみたいと思います。
Private Sub コマンド9_Click()
On Error GoTo Err_コマンド9_Click
Dim oApp As Object
Dim y As Integer
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'Only XL 97 supports UserControl Property
oApp.UserControl = True
'ブックを作成
oApp.Workbooks.Add '新規ワークブックの追加
'フォームのレコードセットを代入する
Dim rs As Recordset 'フォームのレコードセットのクローンをもらう
Set rs = Me.RecordsetClone 'レコードセットのクローンを代入
rs.MoveFirst '先頭行へ移動
y = 1
While rs.EOF = False
'フィールドを転記
oApp.Cells(y, "A") = rs![ID]
oApp.Cells(y, "B") = rs![F_TITLE]
oApp.Cells(y, "C") = rs![F_MEMO]
'次のレコードへ移動
rs.MoveNext 'レコードセット移動
y = y + 1 'セット位置を移動
Wend
'クローンを破棄する
Set rs = Nothing
Exit_コマンド9_Click:
Exit Sub
Err_コマンド9_Click:
MsgBox Err.Description
Resume Exit_コマンド9_Click
End Sub |
ポイントは、
^^^^^^^^^^^^
Dim rs As Recordset 'フォームのレコードセットのクローンをもらう
Set rs = Me.RecordsetClone 'レコードセットのクローンを代入
で、
フォーム.レコードセット複製を受け取り、
Set oApp = CreateObject("Excel.Application")
で作成したExcelに対して、
下記のように、レコードの先頭から終わりまで、データを転記してます。
rs.MoveFirst '先頭行へ移動
y = 1
While rs.EOF = False
'フィールドを転記
oApp.Cells(y, "A") = rs![ID]
oApp.Cells(y, "B") = rs![F_TITLE]
oApp.Cells(y, "C") = rs![F_MEMO]
'次のレコードへ移動
rs.MoveNext 'レコードセット移動
y = y + 1 'セット位置を移動
Wend
この処理で、重たいクエリーが２回まわらなければいいけど。
余談ですが、
Set rs = Me.RecordsetClone
で面白いなぁと感じたのは、
フォームのメニューでフィルターとか並べ替えとか、
ユーザーさんが操作する、
その状態でレコードセットの複製が作成されるみたいなので
フォームの順番どおりにExcelにデータを転記することが出来ました。
別の処理で、フォームからExcelデータ作成時、使えるかなぁとフト思いました。
-【けんぞう！】---------------------------------------------------------
月500円、タバコなら２箱、120円缶コーヒーなら４缶分の謝礼をＧｅｔするなら
http://www.ken3.org/etc/500yen/ ←無料アンケート系の広告です。
『チッ、がんばって回答して月500円かよ』（お馬鹿なプログラマー：30歳）
------------------------------------------------------------------------
/*
* ４．終わりの挨拶
*/
今回は、
レコードセットのクローンを使ってみました。
フォームにデータを表示してるんだから、
同じクエリーでExcelを作らないで、
レコードセットの複製を作成して、自分で代入してみました。
何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
ページフッター(リンクや広告など)
[三流君(TOP ken3.org へ戻る)]
-- [VBA系TOPへ]
---- [VBA系バックナンバー目次へ移動]
------ [VBAでIEを操作 CreateObject("InternetExplorer.application")]・・・実は当店一番人気、VBAでIEを操作するサンプルです
------ [VBAでOutlookの操作 CreateObject("Outlook.Application")]・・・Outlookを使い、メール関係の処理です
------ [Access から Excel 連携 CreateObject("Excel.Application")]・・・人気のAccessからExcelへデータ書き出しなどです
------ [AccessのUserForm/サブフォームを操作]・・・アクセスでフォームを使ったサンプルです
------ [Accessのレポートを操作]・・・レポートを操作してみました
------ [Access クエリー関係やその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です
------ [Excel UserForm(ユーザーフォーム)を操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
------ [ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
------ [Excel関係 関数、その他]・・・その他Excel関係です
------ [VBAでテキストファイル(*.txt,*.html,*.csv)の操作]・・・テキストファイルを使ったサンプルです
------ [VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます
広告
-- [通販系の売れ筋広告へ] ←主に楽天やAmazonのランキングです
blog
-- [三流君の作業日記] ← 日々の作業を少々
-- [通販あしあと] ← 通販ページの足跡を一覧で羅列
情報を探す
情報を探すならGoogleかな？
↓Web全体、サポート情報(support.microsoft.com)や三流君VBA(ken3.org)から検索する
書籍の購入
Webだけじゃさすがに勉強しきれないので、プログラミング関係の書籍も読んでみては？？
コンピュータ書籍の発送がハヤイ専門店
 コンピュータの本・専門店
|
※種類が豊富で探し易いです。※在庫ありが48時間以内発送が急ぎで資料や書籍がほしい時、とても助かります。
お奨め本の目次を見るだけでも勉強になったり
|
amazon.co.jpでキーワード別チェック
下記、私が設定したキーワードですが、こんな感じで資料や書籍を探ってみては？
[VBA全体を把握する] -- やはり全体をさらっと見たいですよね。
[SQL関連でＤＢ力UP] -- システムはデータベース設計が重要
[ADO接続を探る] -- VBAなのでADO接続を押さえておく
[Windows APIを探る] -- さらにAPIになて知ってれば強力だ！
[.NETを探る] -- と言っても時代は.NETに流れてるし
プログラミング以外でも知りたいことは多くって、
[人間関係] -- で、客先・上司、まわりに気を使い。
[プログラマーの自己啓発] -- プログラムだけじゃなくいろいろと向上したいよ
[コーチング・育成] -- 先輩になったら後輩(部下)の面倒をみてね。
そんなこんなでプログラマーっていろいろと大変なんだってば・・・