コマンドライン引数で、Webを検索すると、出てくる出てくる、
サンプルが。
その中で、
GetCommandLine ってものを見つけました。
^^^^^^^^^^^^^^
'実はAPIまるでわからない三流作者、宣言文を丸ごとコピー
Private Declare Function GetCommandLine _
Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function lstrcpy _
Lib "kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As String, _
ByVal lpString2 As Any) As Long
Private Sub Auto_open()
Dim sBuf As String
sBuf = Space$(255) 'バッファをスペース埋めで取る
'呪文じゃないが、GetCommandLine()関数を呼びlstrcpyでバッファにコピー
Call lstrcpy(sBuf, GetCommandLine())
'確認のため表示
MsgBox "起動方法は、[" & sBuf & "]です"
Debug.Print "[" & sBuf & "]"
End Sub
コマンドライン引数で、Webを検索すると、
VBScriptで引数を受け取る方法なんて今回のExcelに無関係そうなものも拾える。
拡張子を.vbsとしてファイルを作成します。
~~~~~~~~~~~~~
test.vbs
^^^^^^^^
msgbox "test"
なんて一行書いて、保存。
ダブルクリックで実行すると、
あらら不思議、メッセージが表示されたよ。
↑実行結果
これがウイルスの温床と噂のVBスクリプトってヤツですね。
よんでね.VBSとかファイル名を付けて、添付する・・なんてヤツですね。
まぁ、そんな話は、置いといて、
次の VBScript コードは、名前付きのコマンド ライン引数を表示する例です。
Set WshArguments = WScript.Arguments
Set WshNamed = WshArguments.Named
If WshNamed.Exists("a") Then
msgbox "A=" & WshNamed("a")
Else
Msgbox "引数Aが見つかりませんでした"
End If
で、Aの値を取れるんだぁ。
テストでまず、test.vbsのショートカットを作成します。
※右クリックでショートカット作成
作成したショートカットのプロパティを開きます。
↑ショートカットを右クリック、プロパティを選択
プロパティのリンク先に
~~~~~~~~~~~~~~~~~~~~
E:\Work\test.vbs /A:Ken3 /B:1234
と値を入れます。
↑リンク先に起動パラメータを代入
ダブルクリックして実行すると、パラメータが渡ったことが確認できます。
/*
* 5.VBScriptからExcelファイルを開く
*/
さてと、複合技じゃないけど、
直接意中の彼女にラブレター(パラメータ)渡せないんだったら、
共通の友人(VBScript)にお願いして、間接的に渡してみる、
そんな手段を考えました。
※でも、ラブレター、告白は直接でしょホントは、、、?
直接出来なきゃねぇ・・・と話をそらしてみました(笑)
まぁ、間接的にでも渡せないよりは、渡せたほうがいいのかな。
まずは、Excelの起動とファイルを開くルーチンの復習で、
過去のメルマガを検索すると、初めのほうで、
No.2 AccessからExcel出力
http://www.ken3.org/backno/backno_vba01.html#2
で、
Dim oApp As Object
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'Only XL 97 supports UserControl Property
On Error Resume Next
oApp.UserControl = True
'*1↓頭にCreateObjectで作成した変数を追加しただけ
oApp.Workbooks.Open FileName:="D:\vba002\TYPE.xls"
'^^^^
なんてAccessからExcelを起動して、ファイルを開いてたよね。
これをそのままVBScriptに持っていきテストします。
おいおい、コンパイルエラーかよ(笑)
↑エラー画面
あっ、VBScriptって変数の型指定ができないんだっけ、
Dim oApp As Object
みたいに、As XXXXはダメなんだっけ、忘れてた。
これを取って、
えっ、まだダメなの?
oApp.Workbooks.Open FileName:="E:\work\vba086.xls"
の場所?
oApp.Workbooks.Open "E:\work\vba086.xls"
と引数の名前指定を外して見た(う〜ん、後で調査ですね)
無事、固定のファイルが開けたので、
今度はパラメータをFILE:E:\work\vba086.xlsで渡せるかチェックする。
ショートカットのリンクを
E:\Work\test.vbs /FILE:E:\work\vba086.xls
とファイル名をパラメータで渡すように変更してみた。
VBScript側で、ファイル名(引数)を受け取り、
そのファイルを開いてみた。
Dim oApp
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'Only XL 97 supports UserControl Property
On Error Resume Next
oApp.UserControl = True
'引数のチェック、ファイルを開く
Set WshArguments = WScript.Arguments
Set WshNamed = WshArguments.Named
If WshNamed.Exists("file") Then
oApp.Workbooks.Open WshNamed("file") 'ファイルを開く
msgbox "File=" & WshNamed("file")
Else
Msgbox "引数Fileが見つかりませんでした"
End If
なんとか、ファイルを開くことが出来ました。
やりたいのは、彼女(Excel)にラブレター(パラメータ)を渡すんだっけ。
No.54 AccessからExcel開いて、処理終了後に閉じたい
http://www.ken3.org/backno/backno_vba11.html#54
で、.RUNってメソッドで、マクロを起動してたっけ。
受け取り側のExcelファイルを下記のように変更して、
^^^^^^^^^^^^^^^^^
Private Sub START(strP As String)
If IsEmpty(strP) Then 'パラメータ無しか?
'パラメータ無しの処理
MsgBox "パラメータ無しで起動されました"
Else
'パラメータありの処理
MsgBox "受け取ったのは" & strP & "です"
End If
End Sub
ショートカットのリンクを
E:\Work\test.vbs /FILE:E:\work\vba086.xls /P:総務
とファイル名とパラメータを渡すように変更、
↑ショートカットにパラメータを追加
VBScript側では、.Runメソッドを使用して、
STARTマクロを起動、パラメータを1つ渡します。
Dim oApp
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
'Only XL 97 supports UserControl Property
On Error Resume Next
oApp.UserControl = True
'引数のチェック、ファイルを開く
Set WshArguments = WScript.Arguments
Set WshNamed = WshArguments.Named
If WshNamed.Exists("file") Then
oApp.Workbooks.Open WshNamed("file") 'ファイルを開く
If WshNamed.Exists("p") Then
oApp.Run "START", WshNamed("p")
Else
Msgbox "引数Pを指定してください"
End If
Else
Msgbox "引数Fileを指定してください"
End If
ポイントは
~~~~~~~~~~
oApp.Run "START", WshNamed("p")
と、マクロ名と引数としてパラメータを渡してます。
実行すると、総務とExcelで受け取ることが出来ました。
↑実行結果
メールで下記の質問をもらいました。
---------------
In message "アクセスVBAでwindowの閉じ方、グループでのデータ取得法...",
>あとひとつは、やはりアクセスで、
>グループ処理のとき、次のデータから
>
> fld1 fld2 fld3
> あ 2 a
> あ 1 b
> あ 4 c
>
>「あ」でグループ化し、fld2から 最小値 1をえらび
> fld3 については、bを表示させたいのですが、
>(fld2に属するfldsのデータを選ぶ)
>
>どうすればよろしいのですか。
---------------
そんな質問に対して、
よく使うだろうと思う、DLookupを使ってみたいと思います。
/*
* 2.クエリーとDLookupでかわしてみようと思った
*/
クエリーとDLookupでできそうです。
fld1 fld2 fld3
あ 2 a
あ 1 b
あ 4 c
「あ」を条件にして、fld2で小さい順にされているクエリーから
fld3の値を取り出す。
と方針を少し変えてみました。
まぁ、軽くテストでもするかな。
※下記失敗作です、動かないので注意。
Sub aaa() '失敗作・・・SQL直接は記述できないのかなぁ?
Dim data As String
Dim strSQL As String
'fld2の小さい順に並べたデータの集合がほしいので
strSQL = "select * from TEST_TABLE order by fld2"
'必要なデータfld3をstrSQLの集合から条件はfld='あ'で検索
data = DLookup("fld3", strSQL, "fld1 = 'あ'")
MsgBox data
End Sub
TEST_TABLE
ID fld1 fld2 fld3
1 あ 2 a
2 あ 1 b
3 あ 4 c
4 い 5 a
5 い 6 b
6 い 4 c
7 い 10 d
fldの小さい順に並べたデータがほしかったので、
select * from TEST_TABLE order by fld2
とオーダーして
ID fld1 fld2 fld3
2 あ 1 b
1 あ 2 a
3 あ 4 c
6 い 4 c
4 い 5 a
5 い 6 b
7 い 10 d
とキレイになったデータからDLookupしたかったので、
'fld2の小さい順に並べたデータの集合がほしいので
strSQL = "select * from TEST_TABLE order by fld2"
'必要なデータfld3をstrSQLの集合から条件はfld='あ'で検索
data = DLookup("fld3", strSQL, "fld1 = 'あ'")
と書いてみたが、この書き方は、ダメなんだぁ、、
↑実行時エラーの画面
しかたがない、ワンクッション置いたクエリーを作成するかな。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
↑fld2でソートしたクエリーの作成
で、そのクエリーを元にデータをチェックします。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
下記、Accessのフォームに貼ったコマンドボタンです。
txtA [ ___ ]に条件を入れてテスト。
Private Sub コマンド2_Click()
Dim data As Variant
'直接の値でやってたけど、フォームの値を利用して、
data = DLookup("fld3", "Q_CHK", "fld1 = '" & Me![txtA] & "'")
MsgBox "fld3=" & data
End Sub
普通に、
DLookup("取り出したい項目", "データ場所", "条件")
を使用して、
DLookup("fld3", "Q_CHK", "fld1 = '" & Me![txtA] & "'")
と関数を作りました。
フォームに条件"い"を入れて検索してみます。
↑フォームから検索した結果
それにしてもなぜ?
Dim data As Variant
~~~~~~~~~~~~~~~~~~~
えっとですね、
データが無いときに、"う"など見つからなかった時に、
Stringだと、Dlookupの戻り値がNULLなので、エラーが発生してしまうので。。。
↑フォームから検索した結果
いつものかわしかたで、
Dim data As String
'直接の値でやってたけど、フォームの値を利用して、
data = "" & DLookup("fld3", "Q_CHK", "fld1 = '" & Me![txtA] & "'")
と
””&〜と強引に文字列にする、なんて逃げ方もあります。
Private Sub ken3_検索_Click()
Dim 探したID
Dim str検索条件 As String
'検索条件を作成
str検索条件 = "照明番号 = '" & Trim(Me![ken3_番号]) & "'"
'該当するIDを照明番号台帳サブから検索する
探したID = DLookup("ID", "照明番号台帳サブ", str検索条件)
'検索がOKか判断する
If IsNull(探したID) Then
MsgBox "証明書番号" & Me![ken3_番号] & "は見つかりませんでした"
Else
'IDが見つかったら、レコードを移動させたい
DoCmd.GoToControl "ID" 'IDフィールドに入力を移動
'指定した条件のIDを探す
DoCmd.FindRecord 探したID
End If
End Sub
Private Sub btn選択_Click()
On Error GoTo Err_btn顧客_Click
DoCmd.Close
Exit_btn選択_Click:
Exit Sub
Err_btn選択_Click:
MsgBox Err.Description
Resume Exit_btn選択_Click
End Sub
まぁ、エラー処理今回は、消しちゃいます。(オイオイ平気なの?)
Private Sub btn選択_Click()
DoCmd.Close '閉じる
End Sub
Private Sub btn選択_Click()
Dim LNG顧客番号 As Long
'番号選択のチェック
If IsNull(Me![lst顧客番号]) Then '何も選択されていないか?チェック
MsgBox "顧客番号を選択してください"
Exit Sub '関数を抜ける
End If
'番号をローカル変数に保存する
LNG顧客番号 = Me![lst顧客番号]
Debug.Print LNG顧客番号 'テバックで表示
'フォームを閉じる
DoCmd.Close
'レコードを移動する
DoCmd.GoToControl "顧客番号" '顧客番号フィールドにコントロールを移動
DoCmd.FindRecord LNG顧客番号 '選択された番号のレコードに移動
'
End Sub