[三流君] −−> [VBAで楽しく] −−> [バックナンバー一覧]
−−> No.007 MDBと同フォルダのExcelファイルを開く

MDBと同フォルダのExcelファイルを開く

メルマガ発行内容

<MDBと同フォルダのExcelファイルを開く>

こんにちは、Ken3です。 前回、VB,Access,Excelなどで、 ファイルの起動場所を知る方法 をやったので、 今回は、単に応用して、 AccessのMDBと同フォルダのExcelファイルを開いてみたいと思います。 前回からの復習も兼ねて、いつものように遠まわしで説明してるので、 暇な人はお付き合いを。 実行できるサンプルを http://www.ken3.org/vba/lzh/vba007.lzh からダウンロード可能にしました。使ってみてください。 /* * 1.仕様、やりたいこと */ プログラムを組む前には、どんなことやりたい? こんなこと? など、作りたい最終結果のイメージをもらいます。 In message "[VBAで楽しく No.002] - AccessからExcel出力", > >現在、Access2002にてデータを管理する物を作って、 > >仕事で使用しているのですが、 > >これまでは、抽出データをレポートに出力するだけでよかったのですが、E > >xcelの定型フォーマットへ出力することになりました。 > > > >Helpでは、「TransferSpreadsheet」 メソッドで出来る様な事は記載されて > >いるのですが、決まったフォーマットへデータの埋め込みは > >出来そうも有りません。 > >どのようにやったら、実現出来るのでしょうか? > > > >例 > > > >ID・・・・・・セルB4 > >Name・・・・・セルC4 > >Address ・・・セルB6 > >TEL ・・・・・セルD7 > > > >こんな感じで、このデータはこのセルといった具合に > >出力セルを指定したいのです。 --- とか、やりたいことを聞きます。 まぁ、ここからの仕様の理解度、プログラムへの落し方が 意外と評価をわけたり、腕の見せ所なんだけど、 /* * 2.仕様の理解度? まずは、固定処理 */ えっと、AccessからExcelファイルを開いて、 データをセットすればいいんだろ? Excelのファイルは、 D:\vba002\TYPE.xls を開いて、 フォーム上の値を ID・・・・・・セルB4 Name・・・・・セルC4 Address ・・・セルB6 TEL ・・・・・セルD7 にセットすればいいや と理解した場合は、 Private Sub コマンド0_Click() On Error GoTo Err_コマンド0_Click 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" '^^^^ '*2 Range("A1").Value ="XXXX" でデータをセットする oApp.Range("B4").Value = Me![ID] oApp.Range("C4").Value = Me![Name] oApp.Range("B6").Value = Me![Address] oApp.Range("D7").Value = Me![TEL] Exit_コマンド0_Click: Exit Sub Err_コマンド0_Click: MsgBox Err.Description Resume Exit_コマンド0_Click End Sub とこんな感じかなぁ。 /vba/backno/vba002.html に画像付きで詳細あるけど、 最低限の、Excelを開いて、データをセットすることは出来たのかなぁ。 /* * 3.エラーチェックを追加、修正ヶ所を少なくする。 */ まぁ、次のレベルに進むと(自然に慣れて来るんだけど) エラー処理やプログラムの修正ヶ所を少なくする、 なんて工夫を身につけると思います。 /vba/backno/vba003.html に詳細あるけど、 In message "[VBAで楽しく No.003] - Dir関数でファイルの存在をチェックする", mag2 ID 0000099159さん wrote... >Dir("ファイル名") >で見つからなかった時に長さ0の文字列を返してくるので、 >If Dir("D:\vba002\TYPE.xls") = "" Then >でチェックできます。 > >Private Sub コマンド0_Click() >On Error GoTo Err_コマンド0_Click > > Dim oApp As Object > > '*3ファイルの存在をチェックする > If Dir("D:\vba002\TYPE.xls") = "" Then > MsgBox "D:\vba002\TYPE.xls を 確認して下さい" > Exit Sub '途中で抜ける > End If > > Set oApp = CreateObject("Excel.Application") > oApp.Visible = True > 'Only XL 97 supports UserControl Property > oApp.UserControl = True > > '*1↓頭にCreateObjectで作成した変数を追加しただけ > oApp.Workbooks.Open FileName:="D:\vba002\TYPE.xls" > '^^^^ > > '*2 Range("A1").Value ="XXXX" でデータをセットする > oApp.Range("B4").Value = Me![ID] > oApp.Range("C4").Value = Me![Name] > oApp.Range("B6").Value = Me![Address] > oApp.Range("D7").Value = Me![TEL] > >Exit_コマンド0_Click: > Exit Sub > >Err_コマンド0_Click: > MsgBox Err.Description > Resume Exit_コマンド0_Click > >End Sub > >*3 >みたいな感じでファイルの存在をチェックできます。 > >へぇ〜、よかったね。 >でも、 >D:\vba002\TYPE.xls >固定なんでしょ? >Dドライブの無いマシーンにインストールする時は、 >プログラム直さないと動作しないジャン? > >oApp.Workbooks.Open FileName:="D:\vba002\TYPE.xls" >を >oApp.Workbooks.Open FileName:="C:\vba002\TYPE.xls" >とかにね。 --- Dir関数を使って、 Excelの元ファイルが存在するかの エラーのチェックは出来たよね。 ここで問題だったのが、 固定で、 D:\vba002\TYPE.xls となってましたよね。 小細工で一ヶ所修正すればOKにするために、 Constで変数宣言を行いました。 http://www.ken3.org/backno/backno_vba02.html#5-4 に詳細あるけど、 In message "[VBAで楽しく No.005] - 変数・乱数・定数", >フォルダーの変更をした時には、全てのヶ所を修正しないといけません。 >そこで、 >Constを使用した定数宣言を行います。 > >Private Sub コマンド0_Click() >On Error GoTo Err_コマンド0_Click > > Const strXLSFILE As String = "D:\vba002\TYPE.xls" > '*4^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ > > Dim oApp As Object > > 'ファイルの存在をチェックする > If Dir(strXLSFILE) = "" Then > MsgBox strXLSFILE & " を 確認して下さい" > Exit Sub '途中で抜ける > End If > > Set oApp = CreateObject("Excel.Application") > oApp.Visible = True > 'Only XL 97 supports UserControl Property > oApp.UserControl = True > > '*1↓頭にCreateObjectで作成した変数を追加しただけ > oApp.Workbooks.Open FileName:=strXLSFILE > '^^^^ > > '*2 Range("A1").Value ="XXXX" でデータをセットする > oApp.Range("B4").Value = Me![ID] > oApp.Range("C4").Value = Me![Name] > oApp.Range("B6").Value = Me![Address] > oApp.Range("D7").Value = Me![TEL] > >Exit_コマンド0_Click: > Exit Sub > >Err_コマンド0_Click: > MsgBox Err.Description > Resume Exit_コマンド0_Click > >End Sub > >使用方法は、 >Const 変数名 as Type = 値 >と書きます。 >Const strXLSFILE As String = "D:\vba002\TYPE.xls" > >If Dir(strXLSFILE) = "" Then >と使用しているので、環境が変化した時は、 >頭の >Const strXLSFILE As String = "D:\vba002\TYPE.xls" >を >Const strXLSFILE As String = "F:\DATA\make\TYPE.xls" >など書き直せば動作するので、 >メンテナンスがラクです。 と Constを使用すると、プログラムの修正が楽なんですよ なんて、強引にConstの説明に使用してましたね。 長いよ説明が・・・で何がいいたいの? えっと、 エラーチェックは入れましょうね と プログラムを修正しやすくするには かなぁ。 さらに一歩進めて、 プログラムを直さなくても動作する そんなことは出来ないの? /* * 4.MDBと同フォルダのExcelファイルを開く */ さて、長かった前置きもこれくらいにして、 MDBと同フォルダのExcelファイルを開く をやってみましょう。 プログラムの仕様、やりたいことを少し変更します。 動作仕様 Accessのフォームからデータセットのボタンが押されたら、 MDBと同一のフォルダー\TYPE.xls (Excelのフォーマットファイル) を開いて、 フォーム上の値を ID・・・・・・セルB4 Name・・・・・セルC4 Address ・・・セルB6 TEL ・・・・・セルD7 にセットする。 同一のフォルダー\TYPE.xls が 存在しない場合は、 「インストールを確認して下さい」 とメッセージを表示し、何もしないで終了する。 なんか長くなったよね、 えっと、AccessのMDB起動位置を知るには、 http://www.ken3.org/backno/backno_vba02.html#6-2 で、 CurrentDb.Name なんて説明してたっけ、 ここに、D:\xxxx\yyyy\zzz.mdbが入っているから、 ここからフォルダーを抜き出して、 と 処理を追加すると下記のようになります。 Aさん、Bさんのマシーンでインストール位置が違っても、 同じフォルダーにMDBとXLSを置いておけば 動作します。 少しは、カッコいいプログラムになったかなぁ。 えっ、まだまだだって? いろいろとアナがあるけど、また今度かなぁ。 *気が付いてるバグ、D:のルートだとバグるよ(笑) 実行できるサンプル http://www.ken3.org/vba/lzh/vba007.lzh を落して、遊んでみてください。 Private Sub コマンド0_Click() On Error GoTo Err_コマンド0_Click Dim strXLSFILE As String 'Excelのファイル名格納場所 Dim oApp As Object 'Excelを操作するオブジェクト変数 Dim strMDBPATH As String Dim strWORK As String Dim i As Integer 'カウンター変数 'Accessの起動位置を取得 CurrentDb.NameにD:\xxxx\yyyy\zzz.mdbが入っている strWORK = CurrentDb.Name '後ろから1文字単位で¥を探す For i = Len(strWORK) To 1 Step -1 If Mid(strWORK, i, 1) = "\" Then Exit For '¥だったら抜ける Next i 'D:\xxxx\yyyy\zzz.mdb --> D:\xxxx\yyyy\ にする strMDBPATH = Mid(strWORK, 1, i) 'Excelの元ファイルの名前を作成 D:\xxxx\yyyy\ + TYPE.xls strXLSFILE = strMDBPATH & "TYPE.xls" 'ファイルの存在をチェックする If Dir(strXLSFILE) = "" Then MsgBox strXLSFILE & " を 確認して下さい" Exit Sub '途中で抜ける End If Set oApp = CreateObject("Excel.Application") oApp.Visible = True 'Only XL 97 supports UserControl Property oApp.UserControl = True '*1↓頭にCreateObjectで作成した変数を追加しただけ oApp.Workbooks.Open FileName:=strXLSFILE '^^^^ '*2 Range("A1").Value ="XXXX" でデータをセットする oApp.Range("B4").Value = Me![ID] oApp.Range("C4").Value = Me![Name] oApp.Range("B6").Value = Me![Address] oApp.Range("D7").Value = Me![TEL] Exit_コマンド0_Click: Exit Sub Err_コマンド0_Click: MsgBox Err.Description Resume Exit_コマンド0_Click End Sub /* * 5.終わりの挨拶 */ 今回は、 過去のメルマガの復習? と 環境の変化に強いプログラムって? を少し書いてみました。 感想・質問などあったら、掲示板に書いてもらえるとうれしいです 三流プログラマーのKen3でした。


ページフッター

ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか?少々心配しつつ、、、

種類別のリンク や 広告など

気になったジャンル↓を選択してください。

人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記3つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係 関数、その他]・・・その他Excel関係です

Access関係:
[Access UserForm/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です

その他:VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます

開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う]

仕様書(設計書?) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力]

※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。
※※読んで、気分を悪くされたらスミマセン。

Blogとリンク:[三流君の作業日記]/ [VBAやASPのサンプルコード]/ 広告-[通販人気商品の足跡]



[三流君(TOP ken3.org へ戻る)] / [VBA系TOPへ] / [VBA系バックナンバー目次へ移動]