Excel VBA 他のプログラムとの連係

Excel VBA のトップに戻る
Excel VBA 目次

VBAで他のプログラムを動かす(起動・終了)

ExcelのVBAで、Accessのデータを参照・更新する
 ・Access のデータを検索して、Excelに取り込む(Accessオブジェクト利用)
 ・Access のデータを使って、Excelのセルに貼り込む(連想配列を使う)
 ・Access Jet Engine のバージョンを調べる
 ・Access データベースをシーケンシャルに更新する(ADO接続)
(Excel の Ranking 関数のように順位を算出する)

 ・Excel VBA で Access のデータベースを最適化/修復
 ・dBASE データベースをシーケンシャルに参照する(ADO接続)

VBA で DOSコマンドを実行する

索引


VBAで他のプログラムを動かす(起動・終了)

 下記サイトに詳述されています。

 API関数(ShellExecute)
パソコン活用研究5番街(Visual Basic、Excel(VBA)、BASIC プログラミング研究)
http://homepage2.nifty.com/kasayan/vba/vba4.htm

 Shell関数
パソコン活用研究5番街(Visual Basic、Excel(VBA)、BASIC プログラミング研究)
http://homepage2.nifty.com/kasayan/vba/vba3.htm

 [VB] Win32 アプリケーションを起動させ、終了させる方法
http://support.microsoft.com/kb/129797/ja

 VBから起動したプログラムを終了させる(API)
http://www.geocities.co.jp/SiliconValley/4805/vbtips/vbtips100.htm

 VB テクニック編2 - Windows API、ウィンドウハンドル取得、ウィンドウ制御
http://homepage2.nifty.com/sak/w_sak3/doc/sysbrd/vb_t02.htm

 例えば、マクロで、マウス操作部分を、BearMouse を使って自動化させたい場合は、下記のように書きます。

 Windows OS のバージョンによって、BrMousNT.exe のパスが変わっているので、下記は、パスの存在をチェックして、起動させるパスを決めています。

Sub ベアマウス起動()
   Dim ベアマウス起動 As Variant

   Dim ファイルシステムオブジェクト    As Object
   Dim ファイルパス1 As String
   Dim ファイルパス2 As String

   Set ファイルシステムオブジェクト = CreateObject("Scripting.FileSystemObject")

   ファイルパス1 = "C:\Program Files\BearSofts\BrMouse\BrMousNT.exe"
   ファイルパス2 = "C:\tool\BearMouse\BrMousNT.exe"

   If ファイルシステムオブジェクト.FileExists(ファイルパス1) = True Then
      ベアマウス起動 = Shell(ファイルパス1)
   ElseIf ファイルシステムオブジェクト.FileExists(ファイルパス2) = True Then
      ベアマウス起動 = Shell(ファイルパス2)
   Else
      MsgBox "BrMousNT.exe のパスは、下記のいずれかにして下さい。" & vbNewLine _
            & "C:\Program Files\BearSofts\BrMouse\BrMousNT.exe" & vbNewLine _
            & "C:\tool\BearMouse\BrMousNT.exe"
   End If

   Set ファイルシステムオブジェクト = Nothing

End Sub


Sub ベアマウス終了()
   Dim TaskClean起動 As Variant
   TaskClean起動 = Shell("C:\tool\TaskClean\TaskClean.exe -pc BrMousNT.exe")
End Sub

 解説:
 BearMouse は、ウインドウを持たないため、TaskClean を使って終了させています。
 Excel ブックを閉じるときに自動実行させる方法は、ブックを閉じる時に実行(イベント) を参照下さい。


Shell 関数
 実行可能プログラムを実行し、実行が完了するとプログラムのタスク ID を示すバリアント型 (内部処理形式 Double の Variant) の値を返します。プログラムの実行に問題が発生した場合は、0 を返します。

構文 Shell(pathname[,windowstyle])

Shell 関数は、次の名前付き引数から構成されます。

指定項目 内容
pathname 必ず指定します。バリアント型 (内部処理形式 String の Variant) の値を指定します。実行するプログラム名と必要な引数名またはコマンド ラインのスイッチを指定します。また、フォルダ、またはドライブを含めて指定できます。Macintosh では、MacID 関数を使ってアプリケーションの名前の代わりにシグネチャを指定できます。次の例は、Microsoft Word のシグネチャを使用したものです。
Shell MacID("MSWD")
windowstyle 省略可能です。実行するプログラムのウィンドウの形式に対応するバリアント型 (内部処理形式 Integer の Variant) の値を指定します。引数 windowstyle を省略すると、プログラムはフォーカスを持った状態で最小化され、実行を開始します。Macintosh (System 7.0 以降) では、windowstyle は、アプリケーションの実行中に、そのアプリケーションがフォーカスを取得できるかどうかを指定するだけです。

名前付き引数 windowstyle には、次の値を指定します。

定数 内容
vbHide 0 フォーカスを持ち、非表示にされるウィンドウ。定数 vbHide は、Macintosh では使用できません。
vbNormalFocus 1 フォーカスを持ち、元のサイズと位置に復元されるウィンドウ
vbMinimizedFocus 2 フォーカスを持ち、最小化表示されるウィンドウ
vbMaximizedFocus 3 フォーカスを持ち、最大化表示されるウィンドウ
vbNormalNoFocus 4 最後にウィンドウを閉じたときのサイズと位置に復元されるフォーカスを持たないウィンドウ。現在アクティブなウィンドウは、アクティブのままです。
vbMinimizedNoFocus 6 最小化表示されるフォーカスを持たないウィンドウ。現在アクティブなウィンドウは、アクティブのままです。

解説
 指定したプログラムが問題なく実行できると、プログラムのタスク ID が返されます。タスク ID は、実行中のプログラムを識別する重複しない番号です。指定されたプログラムが実行できないと、エラーが発生します。Microsoft Windows 上で、MacID 関数を使用するとエラーが発生します。

メモ
 既定の設定では、Shell 関数はプログラムを非同期的に実行します。したがって、Shell 関数を使用して実行を開始したプログラムが終了しなくても、Shell 関数の次のステートメントは実行されます。



 DDE (Dynamic Data Exchange)
ExcelVBAでWord(.doc)ファイルを操作する(1)(ケンちゃんの世界)
http://members.at.infoseek.co.jp/kenchan_h/Index20.html
Tcl/TkでDDE?
http://www.geocities.co.jp/SiliconValley/4137/dir1/ddee1.html

 OLE (Object Linking and Embedding)
OLEオートメーションに対応しているソフト(Excel、Word、Access、一太郎 etc.)に限定される。
ExcelVBAでWord(.doc)ファイルを操作する(2)(ケンちゃんの世界)
http://members.at.infoseek.co.jp/kenchan_h/index21.html


Set objShell = CreateObject("Wscript.Shell")
objShell.Run(ファイル名)

 上は、汎用的なファイル オープン スクリプトです。
CreateObject("Wscript.Shell") で、Windows Script Hostのオブジェクトを作っています。
http://www.microsoft.com/japan/technet/scriptcenter/resources/qanda/dec04/hey1215.mspx

 ファイル名が、URLの場合は、WSH Shell オブジェクトのインスタンスを作成し、Run メソッドを使用して既定の Web ブラウザを開き、指定された URL にアクセスします。
 ファイル名に C:\Scripts\ScriptLog.txt のようなファイル パスがある場合、このスクリプトを実行すると、このファイルがメモ帳 (または .txt ファイルに関連付けられた他のアプリケーション) で開きます。
 ファイル名に .doc ファイルのパスがある場合は、このスクリプトを実行することにより、そのドキュメントが Microsoft Word で開きます。


 WMI Fun !!
http://www.wmifun.net/
 アプリケーションを終了する
http://www.wmifun.net/sample/win32_processc.html
Win32_ProcessクラスのTerminateメソッドを使用します。


 VBレスキュー(花ちゃん)
http://hanatyan.sakura.ne.jp/
 他のプログラムの終了を待つには
http://hanatyan.sakura.ne.jp/vbhlp/tap_PrgEnd.htm


 API 技術関連
http://homepage1.nifty.com/MADIA/vb/VBKANREN.htm
 140.アプリケーション(ウインドウ)の強制終了方法
http://homepage1.nifty.com/MADIA/vb/API/AppWinExit.htm

 以下は、nda23 さんの VBA質問掲示板2009/09/07書き込みから転載させていただきました。
http://www.happy2-island.com/bbs/bbs.cgi

'通常の×ボタンで画面を閉じるときの流れ:
'FindWindowで該当ウィンドウを調べ、
'それにSendMessageを使ってWM_CLOSEメッセージを送り込みます。

Declare Function FindWindowA& Lib "USER32" (ByVal C&, ByVal T$)
Declare Function SendMessageA& Lib "USER32" _
    (ByVal H&, ByVal M&, ByVal W&, ByVal L&)
Const WM_CLOSE = &H10

Sub ウインドウ終了()
   Dim H&
   
'   H = FindWindowA(0, "電卓") '← 画面のタイトルバーの文字列(電卓の場合)
   H = FindWindowA(0, "(無題) - sakura 1.6.3.0 ") '← 画面のタイトルバーの文字列(sakuraエディタの場合)
   
   If H <> 0 Then SendMessageA H, WM_CLOSE, 0, 0
End Sub

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


ExcelのVBAで、Accessのデータを参照・更新する

 ExcelのVBAを使って、Accessのデータベースを参照・更新するときは、ADO(ActiveX Data Objects)を使います。

 事例は、Access データベースをシーケンシャルに更新するの項も、参照下さい。

 下記のサイトを、参考にさせていただきました。感謝!!

 畑本賢治(ケンちゃんの世界)さんの、
・ExcelVBAでAccessデータを操作する(3) 〜 ADO基礎編 〜
http://members.at.infoseek.co.jp/kenchan_h/index18.html
infoseek のサービス停止に伴って、消えていました。(-_-;)
文字部分だけは、インターネット保管庫で見つけました。
・ExcelVBAでAccessデータを操作する(4) 〜 ADO応用編 〜
http://members.at.infoseek.co.jp/kenchan_h/index19.html
文字部分だけは、インターネット保管庫で見つけました。

 結城圭介(Happy!Happy!Island)さんの、
「VBS(WSH)事例集」
http://www.happy2-island.com/vbs/cafe01/
http://www.happy2-island.com/vbs/cafe02/
6.2 AccessのDBを開く・閉じる
http://www.happy2-island.com/access/gogo03/capter00602.shtml
5.6 SQLの実行/SELECT
http://www.happy2-island.com/vbs/cafe02/capter00506.shtml
6.5 SQLの実行/INSERT、UPDATE系
http://www.happy2-island.com/vbs/cafe02/capter00605.shtml

 cbc(基礎から始めるAccess_VBA講座)さんの
 Recordsetオブジェクトの作成(ADO編)★
http://www.geocities.jp/cbc_vbnet/ADO/recordset.html
 ポイント:ADOでレコードセットを作るとき、レコードの更新、変更、削除ができるように、RecordsetオブジェクトのOpenメソッドを使います。

 Excelでデータベース操作(Accessと連携)
http://antonsan.net/study/excel/cont_excel.php

 Excel講座 > ExcelからAccessデータを利用する
http://www.serpress.co.jp/excel/vba038.html

 Access2000のRecordsetの使い方
http://www.ne.jp/asahi/hishidama/home/tech/access/recset.html

この種類の目次に戻る↑ 索引へ↓ トップページに戻る

Access のデータを検索して、Excelに取り込む(Accessオブジェクト利用)

 下の例は、 Access のデータベースで持っている、「自社品目番号と客先品目番号の対比表(X-Ref)」を、マクロで、Excelのセルに登録してある「自社品目番号」を検索して、対応する「客先品目番号」を、Excelの右側のセルに書き出すものです。

 結城圭介(Happy!Happy!Island)さんの、
5.6 SQLの実行/SELECT
http://www.happy2-island.com/vbs/cafe02/capter00506.shtml
が、ほとんどそのまま使えました。

追記:
Access のデータを使って、Excelのセルに貼り込む(連想配列を使う)も参照下さい。

Option Explicit

Dim objAccess
Dim objDB
Dim objRS
Dim i
Dim 自社品目番号 As String
Dim 客先品目番号 As String
Dim クエリ As String
Dim 行 As Integer

Sub Access検索()

   ThisWorkbook.Worksheets("Sheet1").Activate
   
   'Accessオブジェクトを作成します
   Set objAccess = CreateObject("Access.Application")
   
   'Access画面を表示します
   objAccess.Visible = True
   
   '既存のMDBファイルを開きます
   objAccess.OpenCurrentDatabase ("D:\原単位\品目番号X-Ref.mdb")
   
   'DBオブジェクトを作ります
   Set objDB = objAccess.CurrentDb
   
   行 = 0
   Do
      行 = 行 + 1
      自社品目番号 = Range("A2").Cells(行, 1).Value
      
      If 自社品目番号 = "" Then
         Exit Do
      End If
      
      If Left(自社品目番号, 1) = "'" Then
         自社品目番号 = Right(自社品目番号, Len(自社品目番号) - 1)
      End If
      
      クエリ = "select 客先番号 from 200812時点 WHERE 自社番号 = " & Chr(34) & 自社品目番号 & Chr(34)
   
      '@SQLを実行します
      Set objRS = objDB.OpenRecordset(クエリ)
      
      'ASQLの実行結果をデータが無くなるまで表示します
      Do Until objRS.EOF = True
   
          'Bフィールド値の表示
          客先品目番号 = objRS("客先番号")
          
          Range("B2").Cells(行, 1).Value = 客先品目番号
          'Cカーソルを次の行へ
          objRS.MoveNext
      Loop
   Loop
   
   'Dレコードセットをクローズします
   objRS.Close
   
   'データベースをクローズします
   objDB.Close
   
   'MDBファイルを閉じます
   objAccess.CloseCurrentDatabase

   '@Accesを終了します
   objAccess.Quit
   
   '各種オブジェクトの破棄
   Set objRS = Nothing
   Set objDB = Nothing
   Set objAccess = Nothing

End Sub


この種類の目次に戻る↑ 索引へ↓ トップページに戻る


Access Jet Engine のバージョンを調べる

 Access Jet Engine (データベース)のバージョンを知りたいので作ってみました。


Sub JETエンジンバージョン取得()

   Dim objAccess
   Dim objDB

   'Accessオブジェクトを作成します
   Set objAccess = CreateObject("Access.Application")
   
   'Access画面を表示します
   objAccess.Visible = True
   
   '既存のMDBファイルを開きます
   objAccess.OpenCurrentDatabase ("D:\既存Access.mdb")
   
   'DBオブジェクトを作ります
   Set objDB = objAccess.CurrentDb
   
   MsgBox objDB.Version

   'データベースをクローズします
   objDB.Close
   
   'MDBファイルを閉じます
   objAccess.CloseCurrentDatabase
   
   '各種オブジェクトの破棄
   Set objDB = Nothing
   Set objAccess = Nothing

End Sub

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


Access データベースをシーケンシャルに更新する(ADO接続)
(Excel の Ranking 関数のように順位を算出する)

 この例は、Excel マクロで、Accessのテーブルの項目の属性の値について、ランキング(順位付け)をして、Accessのテーブルを更新するものです。

 Accessのマクロや、SQL を使って、ランキングを表示する方法は、下記に詳しく書かれています。
http://www.moug.net/tech/acvba/0120012.htm

 ここでは、Excel マクロで、テーブルのデータを抜き出して、ソートして、順位を設定して、結果をテーブルに書き込んでいます。Excel から操作するため、既存の、どのAccessのデータベースでも対象にできる点が、特長です。
 ただし、ランダム書き込みは時間がかかるので、Accessのテーブルを、前もって、Accessで、キーの昇順に並び替えておく必要が有ります。この前提で、私のパソコンで、30万件のデータのテーブルを、30秒で順位書き込みできたので、それなりに役に立つでしょう。

このマクロをダウンロードできます。→Ranking.xls
サンプルのデータベースをダウンロードできます。→test.zip(test.mdb)

 ADO を使うためには、参照設定を追加する必要が有ります。
 VBE の、[ツール(T)]→[参照設定(R)]を選択します。
 表示される、参照設定用のダイアログボックスで、
「Microsoft ActiveX Data Objects *.* Library」にチェックを入れて、[OK]ボタンを押します。
 (注)"*.*"のところは、ADOのバージョンです。新しいものにすると、古いバージョンの Office では動かなくなるので、2.6 あたりを選択すると良いでしょう。

'==============================================
'配列の初期値を1にする
'==============================================
Option Base 1

Dim 開始日時 As Variant
Dim 終了日時 As Variant

Dim 接続 As ADODB.Connection
Dim ファイル名 As String
Dim Accessテーブル As ADODB.Recordset
Dim 選択SQL As String

Dim AccessDB名 As String
Dim Accessテーブル名 As String
Dim キー項目名 As String
Dim 評価項目名 As String
Dim 順位設定項目名 As String
Dim 順方向 As Integer
Dim データ量 As Long
Dim 配列() As Variant

Dim 現在のパス As String
Dim 処理内容 As String
Dim データ件数 As Long
Dim 処理行 As Long
Dim カウンタ As Long
Dim 順位 As Long
Dim 直前順位 As Long
Dim 一時変数 As Variant
Dim 直前値 As Variant

'==============================================
Sub 順位設定()
'==============================================

   開始日時 = Now
   
   '処理の前提のパラメータを設定
   現在のパス = ThisWorkbook.Path
   ThisWorkbook.Worksheets("Sheet1").Activate
   AccessDB名 = Range("B11").value
   Accessテーブル名 = Range("B12").value
   キー項目名 = Range("B13").value
   評価項目名 = Range("B14").value
   順位設定項目名 = Range("B15").value
   順方向 = Range("B16").value
   データ量 = Range("B17").value
   ReDim 配列(データ量, 3)
    
   Call テーブル読み込み
   
   処理内容 = "評価項目でソート"
   Application.StatusBar = "★☆★" & 処理内容 & "★☆★"
   Call クイックソート2次元配列(配列, 1, データ件数)
   Call 順位カウント
   '配列の左端を、比較項目から、キー項目に入れ替える
   Call 列入れ替え
   
   処理内容 = "キー項目でソート"
   Application.StatusBar = "★☆★" & 処理内容 & "★☆★"
   Call クイックソート2次元配列(配列, 1, データ件数)

   Call テーブルに書き込み

    終了日時 = Now
    MsgBox "処理時間は、" _
    & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub


'==============================================
Private Sub テーブルに書き込み()
'==============================================
   処理内容 = "Accessのテーブルに書き込み"
   Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
   データ件数 = 0

'★Accessのデータベースに接続して、テーブルをシーケンシャルに検索して更新
'http://members.at.infoseek.co.jp/kenchan_h/index18.html

    'New キーワードを使用して新規Connectionオブジェクトを生成
    Set 接続 = New ADODB.Connection
    
    '接続先のデータベース
    ファイル名 = 現在のパス & "\" & AccessDB名
    
    '接続
    接続.Open _
      "Provider=Microsoft.Jet.OLEDB.4.0;" _
      & "Data Source=" & ファイル名
    
    'レコードセットの作成(SELECT文の実行)
    Set Accessテーブル = New ADODB.Recordset
    選択SQL = "SELECT * FROM " & Accessテーブル名
    
    'ADOでレコードセットを作成するとき、レコードの更新、変更、削除ができるように、
    'RecordsetオブジェクトのOpenメソッドを使います。
    'http://www.geocities.jp/cbc_vbnet/ADO/recordset.html
    'Recordsetオブジェクトの作成(ADO編)
    
    Accessテーブル.Open 選択SQL, 接続, adOpenKeyset, adLockOptimistic
    
    '最終レコードまで順読み込みを行う
    Do Until Accessテーブル.EOF = True
      データ件数 = データ件数 + 1
       'Accessテーブルの、特定フィールドの値を所得します
       'MS ACCESS 95/97 の美しいソート順:Accessのソートと教科書のソートの違いを吸収
       'http://www.massangeana.com/mas/comp/acccoll.htm#hyphen
       If 配列(データ件数, 1) <> Replace(Accessテーブル(キー項目名), "-", "") Then
         MsgBox "キーが一致しません!"
         Stop
       End If
       
        'フィールドの値を変更
        Accessテーブル.Update 順位設定項目名, 配列(データ件数, 3)
         
       'レコードの順読み
       Accessテーブル.MoveNext

    Loop
    
    'レコードセットのクローズ
    Accessテーブル.Close
    
    '接続を解除
    接続.Close
    'オブジェクトをクリア
    Set Accessテーブル = Nothing
    Set 接続 = Nothing

End Sub

'==============================================
Private Sub 列入れ替え()
'==============================================
   For 処理行 = 1 To データ件数
      一時変数 = 配列(処理行, 1)
      配列(処理行, 1) = 配列(処理行, 2)
      配列(処理行, 2) = 一時変数
   Next 処理行
End Sub

'==============================================
Private Sub 順位カウント()
'==============================================
   処理内容 = "順位設定"
   Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"

   カウンタ = 0
   If 順方向 = 2 Then '昇順
      For 処理行 = 1 To データ件数
         カウンタ = カウンタ + 1
         If 配列(処理行, 1) = 直前値 Then
            順位 = 直前順位
         Else
            直前値 = 配列(処理行, 1)
            順位 = カウンタ
         End If
         配列(処理行, 3) = 順位
         直前順位 = 順位
      Next 処理行
   Else '降順
      For 処理行 = データ件数 To 1 Step -1
         カウンタ = カウンタ + 1
         If 配列(処理行, 1) = 直前値 Then
            順位 = 直前順位
         Else
            直前値 = 配列(処理行, 1)
            順位 = カウンタ
         End If
         配列(処理行, 3) = 順位
         直前順位 = 順位
      Next 処理行
   End If
End Sub


'==============================================
Private Sub テーブル読み込み()
'==============================================
   処理内容 = "Accessのテーブルを読み込み"
   Application.StatusBar = "☆★☆" & 処理内容 & "☆★☆"
   データ件数 = 0
'★Accessのデータベースに接続して、テーブルをシーケンシャルに取得

    'New キーワードを使用して新規Connectionオブジェクトを生成
    Set 接続 = New ADODB.Connection
    
    '接続先のデータベース
    ファイル名 = 現在のパス & "\" & AccessDB名
    
    '接続
    接続.Open _
      "Provider=Microsoft.Jet.OLEDB.4.0;" _
      & "Data Source=" & ファイル名
    
    'レコードセットの作成(SELECT文の実行)
    Set Accessテーブル = New ADODB.Recordset
    選択SQL = "SELECT * FROM " & Accessテーブル名
    
    'ADOでレコードセットを作成するとき、レコードの更新、変更、削除ができるように、
    'RecordsetオブジェクトのOpenメソッドを使います。
    'http://www.geocities.jp/cbc_vbnet/ADO/recordset.html
    'Recordsetオブジェクトの作成(ADO編)
    
    Accessテーブル.Open 選択SQL, 接続, adOpenKeyset, adLockOptimistic
    
    '最終レコードまで順読み込みを行う
    Do Until Accessテーブル.EOF = True
      データ件数 = データ件数 + 1
       'Accessテーブルの、特定フィールドの値を配列に格納します
       'MS ACCESS 95/97 の美しいソート順:Accessのソートと教科書のソートの違いを吸収
       'http://www.massangeana.com/mas/comp/acccoll.htm#hyphen
       配列(データ件数, 2) = Replace(Accessテーブル(キー項目名), "-", "")
       配列(データ件数, 1) = Accessテーブル(評価項目名)
       配列(データ件数, 3) = Accessテーブル(順位設定項目名)

         
       'レコードの順読み
       Accessテーブル.MoveNext

    Loop
    
    'レコードセットのクローズ
    Accessテーブル.Close
    
    '接続を解除
    接続.Close
    'オブジェクトをクリア
    Set Accessテーブル = Nothing
    Set 接続 = Nothing

End Sub


「実行時エラー ’3131′: FROM句の構文エラーです。」が表示されたら
http://chiroinu.freehostia.com/wordpress/?p=310
みるくP ブログで、下記のノウハウを公開していただいていました。

ExcelVBAにてCSVファイルをテーブルとして接続する際、エラーが発生してしまう場合があります。
下記にご注意!
@ファイル名に禁則文字が使われている場合[-ハイフンやスペース等]
Aファイル名のトータルが拡張子を含み59文字を超える場合。(XP、OFFICE2003のみで実験)

@はテーブル名を[]で囲えば解決します。お気をつけを・・・
 ⇒SELECT * FROM [悪い テーブル - 名.csv]


 以下は、順位を設定するために、並び替えをする部分です。
 下記で公開していただいている、「再帰呼び出ししないクイックソート」を使わせていただきました。
 システムエンジニアの戯言→再帰呼び出ししないクイックソート
http://ameblo.jp/blueskyame/entry-10244296193.html
 「再帰呼び出ししないクイックソートは、再帰呼び出しする方式と比べて高速な動作が期待できます。(関数呼び出しによるオーバーヘッドがなくなるので。)」とのことです。

 コードを使うにあたって、下記を参考にしました。

 Excel VBAではじめるクラス入門
http://codezine.jp/article/detail/499

 また、下記で公開していただいている、「2次元配列のデータをソートする関数」を使わせていただきました。
 K-yamadaの日記→2次元配列のデータをソートする関数
http://d.hatena.ne.jp/K-yamada/mobile?word=*%5BExcel%20VBA%5D

 上を参考にして、「スタックデータを表現するクラスモジュール」の定義を登録します。

'==============================================
'配列の初期値を1にする
'==============================================
Option Base 1

'========================================
'2次元配列をクイックソートする。
'一番左の列がソートのキー項目になる。
'========================================
Public Sub クイックソート2次元配列(ByRef 対象配列 As Variant, ByVal 配列要素下限 As Long, ByVal 配列要素上限 As Long)

    Dim 左 As Long
    Dim 右 As Long
    左 = 配列要素下限
    右 = 配列要素上限
    ' スタックオブジェクト
    Dim スタックオブジェクト As New ValStack
    
    ' スタックに格納する値
    ' (対象配列を走査する情報、左端と右端のインデックスを格納する)
    Dim スタックに格納する値 As Variant
    ' 対象配列変数を生成する
    ReDim スタックに格納する値(1 To 2)
    
    
    ' ベースとなる値
    Dim 基準値 As Variant
    
    ' 中心のインデックス
    Dim 中心のインデックス As Long
    Dim i      As Long
    Dim j      As Long

    ' スタックに最初に設定する変数を設定
    スタックに格納する値(1) = 左
    スタックに格納する値(2) = 右
    ' スタックにプッシュする
    スタックオブジェクト.push スタックに格納する値

    ' スタックの中身がなくなるまで実行
    Do While スタックオブジェクト.count > 0
        ' スタックから値を取り出す
        スタックに格納する値 = スタックオブジェクト.pop
        ' 左端を取得
        左 = スタックに格納する値(1)
        ' 右端を取得
        右 = スタックに格納する値(2)
        ' ここからクイックソートのアルゴリズム(教科書どおり)
        If 左 < 右 Then
        
            中心のインデックス = Int((左 + 右) / 2)
            基準値 = 対象配列(中心のインデックス, 1)
            
            i = 左
            j = 右
            
            Do While i <= j
    
                Do While 対象配列(i, 1) < 基準値
                    i = i + 1
                Loop
            
                Do While 対象配列(j, 1) > 基準値
                    j = j - 1
                Loop
            
                If i <= j Then
                    '1行分のデータを入れ替える
                    Call 行入れ替え(対象配列, i, j)
                    i = i + 1
                    j = j - 1
                End If
            Loop
            
            '基準値の左に2以上要素があれば、左の対象配列をソートする
            If 左 < (i - 1) Then
                スタックに格納する値(1) = 左
                スタックに格納する値(2) = i - 1
                スタックオブジェクト.push スタックに格納する値
            End If
            
            '基準値の右に2以上要素があれば、右の対象配列をソートする
            If (j + 1) < 右 Then
                スタックに格納する値(1) = i
                スタックに格納する値(2) = 右
                スタックオブジェクト.push スタックに格納する値
            End If

        End If
    
    Loop
End Sub


'============================================================
'2次元対象配列の1行分のデータを入れ替える
'============================================================
Sub 行入れ替え(処理配列 As Variant, ByVal i As Long, ByVal j As Long)
    Dim 最大列 As Long
    Dim 列 As Long
    Dim バッファ As Variant
    最大列 = UBound(処理配列, 2)
    For 列 = 1 To 最大列
        バッファ = 処理配列(i, 列)
        処理配列(i, 列) = 処理配列(j, 列)
        処理配列(j, 列) = バッファ
    Next
End Sub

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


Excel VBA で Access のデータベースを最適化/修復

  Access のデータベース(.mdb)は、ファイル・サイズが 2GB という制約が有ります。このため、クエリを実行していてファイル・サイズが 2GB を超えると、クエリが失敗します。
 これを防止するため、適当なところで、Excel VBA で、Accessデータベースを最適化/修復して、ファイル・サイズを圧縮するものです。
 この例では、10万件クエリ処理する毎に、いったんデータベースを閉じて、最適化/修復処理をしています。

 このマクロの全体は、ある会社の品目番号を、英数だけのものから、ハイフンを挿入した見やすい体系に変換するものです。
 身近な例に置き換えると、電話番号が有ります。電話番号は数字の羅列です。しかし数字だけで表示すると、視認性が悪いので、通常は、括弧やハイフンを付けて表示します。
 電話番号で言えば、数字の羅列から、局番号やキャリアーなどを辞書引きして、適切にハイフンを挿入するプログラムと考えていただければ、分かると思います。


Option Explicit
Option Base 1

Dim 開始日時 As Variant
Dim 終了日時 As Variant

Dim 接続 As ADODB.Connection
Dim ファイル名 As String
Dim Accessテーブル As ADODB.Recordset
Dim 選択SQL As String
Dim AccessDB名 As String
Dim Accessテーブル名 As String
Dim 現在のパス As String

Dim ハイフン無品番項目 As String
Dim ハイフン有品番項目 As String
Dim 品番パターン項目 As String
Dim 設定パターン項目 As String
Dim ハイフン無 As String
Dim ハイフン有 As String

Dim 正規表現オブジェクト As Object
Dim 品番パターン辞書() As Variant
Dim 品番パターン件数 As Integer
Dim ハイフンパターン As String
Dim ハイフン設定辞書() As Variant
Dim ハイフンパターン件数 As Integer
Dim 検索位置 As Integer
Dim 処理行 As Integer

Dim ハイフンパターン索引 As Object        'Scripting.Dictionary オブジェクト
Dim ハイフンパターン配列添え字 As Integer 'Scripting.Dictionary オブジェクトのデータ
Dim パターン行 As Integer
Dim カウンタ As Long
Dim 全体カウンタ As Long
Dim 最終 As String
Dim strDstMDB As String
Dim jro As jro.JetEngine

Sub ADO接続でAccessテーブルを更新()

    開始日時 = Now

   '処理の前提のパラメータを設定

   現在のパス = ThisWorkbook.Path
   
   
   Set 正規表現オブジェクト = New RegExp
   
   '★辞書データの読み込み
   ThisWorkbook.Worksheets("品番パターン辞書").Activate
   品番パターン件数 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   品番パターン辞書 = Range("A1").Resize(品番パターン件数, 3) '処理速度をあげるため、辞書部分は配列(メモリ)に登録。
   
   ThisWorkbook.Worksheets("ハイフン設定辞書").Activate
   ハイフンパターン件数 = Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
   ハイフン設定辞書 = Range("A1").Resize(ハイフンパターン件数, 3) '処理速度をあげるため、辞書部分は配列(メモリ)に登録。

   '★ハイフンパターン索引を作成★
   Set ハイフンパターン索引 = CreateObject("Scripting.Dictionary")  '★連想配列の定義
   For 処理行 = 1 To ハイフンパターン件数
      ハイフンパターン = ハイフン設定辞書(処理行, 1)                  'ハイフンパターン
      ハイフンパターン索引(ハイフンパターン) = 処理行
   Next 処理行
   
   
   '更新対象を取得
   ThisWorkbook.Worksheets("Access更新").Activate
   
   AccessDB名 = Range("B11").Value
   Accessテーブル名 = Range("B12").Value
   ハイフン無品番項目 = Range("B14").Value
   ハイフン有品番項目 = Range("B15").Value
   品番パターン項目 = Range("B16").Value
   設定パターン項目 = Range("B17").Value
   
   最終 = ""
   Do While 最終 = ""
   
   '★Accessのデータベースに接続して、テーブルをシーケンシャルに検索して更新
   'http://members.at.infoseek.co.jp/kenchan_h/index18.html
   
       'New キーワードを使用して新規Connectionオブジェクトを生成
       Set 接続 = New ADODB.Connection
       
      '接続先のデータベース
       ファイル名 = 現在のパス & "\" & AccessDB名
       
       '接続
       接続.Open _
         "Provider=Microsoft.Jet.OLEDB.4.0;" _
         & "Data Source=" & ファイル名
       
       'レコードセットの作成(SELECT文の実行)
       Set Accessテーブル = New ADODB.Recordset
       選択SQL = "SELECT * FROM [" & Accessテーブル名 & "]"
       
       'ADOでレコードセットを作成するとき、レコードの更新、変更、削除ができるように、
       'RecordsetオブジェクトのOpenメソッドを使います。
       'http://www.geocities.jp/cbc_vbnet/ADO/recordset.html
       'Recordsetオブジェクトの作成(ADO編)
       
       Accessテーブル.Open 選択SQL, 接続, adOpenKeyset, adLockOptimistic
       
       '最終レコードまで順読み込みを行う
       カウンタ = 0
       全体カウンタ = 0
       Do Until Accessテーブル.EOF = True
         全体カウンタ = 全体カウンタ + 1
         If カウンタ > 100000 Then Exit Do ' Access DB が2Gを超えないように
          'Accessテーブルの、特定フィールドの値を取得します
          ハイフン無 = Accessテーブル(ハイフン無品番項目)
          
          If IsNull(Accessテーブル(ハイフン有品番項目)) = True Then
   
           'マクロを使ってハイフン設定
            '正規表現を使って、ワイルドカード照合して、ハイフンパターンを知る
             
            For パターン行 = 1 To 品番パターン件数
                正規表現オブジェクト.Pattern = 品番パターン辞書(パターン行, 1)
                正規表現オブジェクト.IgnoreCase = False
                '大文字小文字を区分する。デフォルトは、True(区別しない)
                
                If 正規表現オブジェクト.Test(Left(ハイフン無, 10)) = True Then '正規表現を使って、ワイルドカード検索。
                    ハイフン有 = _
                    ReplaceRegExpr(CStr(ハイフン設定辞書(ハイフンパターン索引(品番パターン辞書(パターン行, 2)), 2)), Left(ハイフン無, 10), CStr(ハイフン設定辞書(ハイフンパターン索引(品番パターン辞書(パターン行, 2)), 3))) _
                    & Right(ハイフン無, Len(ハイフン無) - 10)
                    
                     'フィールドの値を変更
                     Accessテーブル.Update ハイフン有品番項目, ハイフン有
                     Accessテーブル.Update 品番パターン項目, ハイフン設定辞書(ハイフンパターン索引(品番パターン辞書(パターン行, 2)), 1)
                     Accessテーブル.Update 設定パターン項目, 品番パターン辞書(パターン行, 3)
                     カウンタ = カウンタ + 1
                    Exit For
                End If
            Next パターン行
            
         End If
                        
          'レコードの順読み
          Accessテーブル.MoveNext
   
       Loop
       
       If Accessテーブル.EOF = True Then 最終 = "最終"
       
       'レコードセットのクローズ
       Accessテーブル.Close
       
       '接続を解除
       接続.Close
       'オブジェクトをクリア
       Set Accessテーブル = Nothing
       Set 接続 = Nothing
       
       'データベースを圧縮
       Set jro = New jro.JetEngine
   '    VBAを使ってデータベースを修復/最適化
   '   http://www.tsware.jp/study/vol1/kaibo_09.htm
   '   ADO から Microsoft Access データベースを最適化するには、方法
   '   http://support.microsoft.com/kb/230501/ja
       '最適化先の一時MDBファイルのフルパスを設定
       strDstMDB = 現在のパス & "\" & "~tmp" & AccessDB名
       
       '最適化の実行
       jro.CompactDatabase _
       "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ファイル名 _
       , "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strDstMDB

       '最適化元のファイルを削除
       Kill ファイル名
       '最適化先のファイル名を最適化元のファイル名にリネーム
       Name strDstMDB As ファイル名
       Set jro = Nothing
   Loop

   Set 正規表現オブジェクト = Nothing
   ThisWorkbook.Worksheets("Access更新").Activate
   
   Range("B21").Value = 全体カウンタ
    
   終了日時 = Now
   MsgBox "処理時間は、" _
   & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub

この種類の目次に戻る↑ 索引へ↓ トップページに戻る


dBASE データベースをシーケンシャルに参照する(ADO接続)

 接続先のデータベースとして、Access ではなく、dBASE の .dbf に接続して、データベースの内容を VBA で読みとる場合のコード例を紹介します。
dBASE とは→http://ja.wikipedia.org/wiki/DBASE

 dBASE に接続する場合は、パスとテーブルの指定区分が Access とは異なる点に、注意が必要です。

   ←   ファイル・パス → ←テーブル名 →
   フォルダパス\AccessDB名.mdb Accessテーブル名

         フォルダ・パス\dBASEのDB名.dbf
   ←   ファイル・パス → ←テーブル名→

dBASE では、ファイル・パスに「フォルダ・パス」を指定します。テーブル名に「ファイル名(拡張子なし)」を、指定します。

データベースでは、項目が空白の場合に、Null値が入っていることがあります。VBA の変数で、Null値を受け取ることができるのは、Variant 変数のみです。このため、下の例では、ユーザ定義関数を使って、Null値を「空白」に変換して、String 変数に格納できるようにしています。

 ADO を使うためには、参照設定を追加する必要が有ります。
 VBE の、[ツール(T)]→[参照設定(R)]を選択します。
 表示される、参照設定用のダイアログボックスで、
「Microsoft ActiveX Data Objects *.* Library」にチェックを入れて、[OK]ボタンを押します。
 (注)"*.*"のところは、ADOのバージョンです。新しいものにすると、古いバージョンの Office では動かなくなるので、2.6 あたりを選択すると良いでしょう。

Option Explicit
Option Base 1

Dim 処理件数 As Integer
Dim 開始日時 As Variant
Dim 終了日時 As Variant
Dim カウンタ As Long

Dim 接続 As ADODB.Connection
Dim ファイル名 As String
Dim ファイルのフォルダ As String
Dim dBASEテーブル As ADODB.Recordset
Dim 選択SQL As String
Dim テーブル名 As String

Dim 品番 As String
Dim 品名 As String


Sub ADO接続でdBASEのDBを読む()

    '接続先のデータベース
   ファイル名 = Application.GetOpenFilename("dBASEのファイル,*.dbf")
   If ファイル名 = "False" Then End
   テーブル名 = Dir(ファイル名)
   テーブル名 = Left(テーブル名, Len(テーブル名) - 3) '拡張子を除く
   ファイルのフォルダ = Left(ファイル名, InStrRev(ファイル名, "\") - 1)

    開始日時 = Now

        
    '★dBASEのデータベースに接続して、テーブルをシーケンシャルに検索して更新

    'New キーワードを使用して新規Connectionオブジェクトを生成
    Set 接続 = New ADODB.Connection
        
    '接続
   接続.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & ファイルのフォルダ & _
          ";Extended Properties=dBASE 5.0;"


    'レコードセットの作成(SELECT文の実行)
    Set dBASEテーブル = New ADODB.Recordset
    選択SQL = "SELECT * FROM " & テーブル名
    
    'ADOでレコードセットを作成するとき、レコードの更新、変更、削除ができるように、
    'RecordsetオブジェクトのOpenメソッドを使います。
    'http://www.geocities.jp/cbc_vbnet/ADO/recordset.html
    'Recordsetオブジェクトの作成(ADO編)
    
    dBASEテーブル.Open 選択SQL, 接続, adOpenKeyset, adLockOptimistic
    
    '最終レコードまで順読み込みを行う
    'http://www.happy2-island.com/vbs/cafe02/capter00506.shtml
    カウンタ = 0
    Do Until dBASEテーブル.EOF = True
      カウンタ = カウンタ + 1

      If カウンタ Mod 10000 = 0 Then
      
         'dBASEテーブルの、特定フィールドの値を所得します
         品番 = dBASEテーブル("HIN")
         品名 = 文字列化(dBASEテーブル("Name"))
         Application.StatusBar _
         = CStr(カウンタ) & "件目 " & 品番 & " " & 品名

      End If

       'レコードの順読み
       dBASEテーブル.MoveNext

    Loop
    
   Application.StatusBar _
   = CStr(カウンタ) & "件目 " & 品番 & " " & 品名
    
    'レコードセットのクローズ
    dBASEテーブル.Close
    
    '接続を解除
    接続.Close
    'オブジェクトをクリア
    Set dBASEテーブル = Nothing
    Set 接続 = Nothing
    
    終了日時 = Now
    MsgBox "処理時間は、" _
    & Format(終了日時 - 開始日時, "hh時間nn分ss秒") & " でした。"

End Sub

Function 文字列化(バリアント As Variant) As String
   文字列化 = IIf(IsNull(バリアント) = True, "", バリアント)
End Function

 解説:
dBASE に接続するための引数は、下記のサイトで教えていただきました。
http://www.mrexcel.com/forum/showthread.php?t=355455

   Set cn = New ADODB.Connection
     cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & DBDirectory & _
     ";Extended Properties=DBASE IV;"
     Set rs = New ADODB.Recordset
       With rs
         .Open "SELECT * FROM [MISS_T~3.dbf]", cn, , , adCmdText

下記で紹介されているコードでは、うまく接続できませんでした。
http://msdn.microsoft.com/ja-jp/library/dd148538.aspx


IsNull 関数は、式に Null 値が含まれているかどうかを調べ、結果をブール型 (Boolean) で返します。
構文
IsNull(expression)
引数 expression は必ず指定します。引数 expression には、数式または文字列式を含むバリアント型 (Variant) の式を指定します。

IsNull 関数は、引数 expression の値が Null 値である場合は、真 (True) を返します。それ以外は偽 (False) を返します。
引数 expression が複数の変数で構成されている場合、変数が 1 つでも Null 値のときには式全体が Null 値となり、真 (True) が返されます。

Null 値は、バリアント型 (Variant) に有効なデータが入っていないことを示す値であり、変数が初期化されていないことを示す Empty 値や、Null 文字列と呼ばれる長さが 0 の文字列 ("") とは異なります。

IsNull 関数を使用すると、式に Null 値が含まれているかどうかを調べることができます。
If Var = NullIf Var <> Null のように他の状況では真 (True) と評価される式でも、偽 (False) になります。これは、Null 値を含む式はすべて式自体が Null 値となり、偽 (False) と評価されるためです。


この種類の目次に戻る↑ 索引へ↓ トップページに戻る


VBA で DOSコマンドを実行する


 Shell関数を用いて DOS のコマンドを実行する方法
http://support.microsoft.com/kb/404917/JA/

 DOS コマンドの実行結果を取得する方法
http://www.f3.dion.ne.jp/~element/msaccess/AcTipsGetDosResult.html

 VBAからDOSのコマンドを実行する方法
http://billyboy.blog81.fc2.com/blog-entry-77.html

この種類の目次に戻る↑ 索引へ↓ トップページに戻る



ホームページのトップに戻る