Microsoft Access2003

Page 12 (2005/02)

Accessからディスクのファイルを扱う
CurDir() これは引数を省略すると単純にカレントディレクトリ名を返す関数。ドライブを指定するとそのドライブのパスを返します。
? CurDir("C")
C:\Documents and Settings\shimane hiroshi\My Documents

ChDrive これは関数ではなくステートメント。名前の通りドライブを変更します。単純にドライブの変更だけ。ディレクトリ指定は不可。  ChDrive "D"

ChDir()  こちらがディレクトリ変更のための関数。  ChDir("\tool")

Dir()   これはパスを指定してファイル名、フォルダ名を求める関数。Accessのヘルプにある使用例がその使い方を理解する参考になります。
Dir(ファイル名、属性[省略可])という使い方です。DOSのDIRコマンドのように一気にすべてのファイルをリスとするのではなく、すべてのファイルを対象にする。
Dir(*.*)のあと、ループのなかで引数無しの Dir()ですべてのファイルを対象にします。
Sub Test_Dir()
  Dim MyFile, MyPath, MyName
  MyFile = Dir("C:\WINDOWS\WIN.INI")' "WIN.INI" が存在する場合、そのファイル名を返します(Microsoft Windows の場合)。
  MyFile = Dir("C:\WINDOWS\*.INI") ' 指定した拡張子を持つファイル名を返します。複数の *.INI ファイル が存在すると、
                             '最初に見つかったファイル名を返します。

  MyFile = Dir ' 引数を指定せずに再度 Dir 関数を呼び出すと、 同じフォルダにある次の *.INIファイルを返します。
  MyFile = Dir("*.TXT", vbHidden)' 隠しファイル属性を持つ *.TXT ファイルであり、最初に見つかったファイル名を返します。
  MyPath = "c:\"  ' C:\ 内のフォルダの名前を表示します。 ' パスを設定します。
  MyName = Dir(MyPath, vbDirectory)  ' 最初のフォルダ名を返します。
  Do While MyName <> ""  ' ループを開始します。
     ' 現在のフォルダと親フォルダは無視します。

    If MyName <> "." And MyName <> ".." Then
       ' ビット単位の比較を行い、MyName がフォルダかどうかを調べます。
      If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
        Debug.Print MyName    ' フォルダであれば、それを表示します。
      End If
    End If
    MyName = Dir          ' 次のフォルダ名を返します。
  Loop
End Sub
このプログラム、動かしてみると不思議なことがいくつか起こります。まず、隠しフォルダは処理対象にならない。これはなるほどそうか・・と納得できます。
もう一つは、Autoexec.bat Config.sysなどがフォルダとしてチェックされること。このふたつはシステムファイルとして通常はC:\には表示されない。
隠しファイルではないけど非表示ファイルということか?いずれにしても、ファイルであってフォルダではないはずなのに・・・。
ちなみに、GetAttr("Autoexec.bat")は32を返します。これはアーカイブ属性ということらしいが・・・。
GetAttr()関数  指定したファイルやフォルダの属性を整数で返します。上の例ですと、定数vbDirectoryは16です。
            隠しファイルはvbHiddenで 2 といった具合ですが、やっかいなのは、これら数種類の属性が組み合わされているということです。
ですから、単純に GetAttr(フォルダ名)で 16 が返るわけではない。もしそのファイルが隠しフォルダである場合は、16+2 で 18 が返ります。
ということで、上のコードの例のように、ちょっと変わった条件文を使うことになります。
(GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory
論理演算子And のこのような使い方はかなり分かりにくいですが、GetAttr関数の返値が定数vbDirectoryと等しい?というか含む場合は、この式の返値はvbDirectoryになります。vbDirectoryを含まない場合の返値は 0 になるということです。

下のコードはDir関数の分かりやすい使用パターンです。
Dim strFile As String, strName As String, intCount As Integer
strFile = Dir("C:\Documents and Settings\My Documents\My Pictures\*.BMP")
strName = ""
Do While strFile <> ""
  intCount = intCount + 1
  strName = strName & strFile & ","
  strFile = Dir()
Loop
If intCount = 0 Then
  MsgBox "ファイルがみつかりませんでした"
Else
   MsgBox "bmpファイルが " & intCount & "個見つかりました" & vbCrLf & strName
End If
フォームがオープンしているかどうかを調べる
上の図は Page 5 使ったフォームです。他のフォームのプロシージャを呼ぶ方法とパブリック、プライベートの違いを理解するために作ってみたものです。
ここでは下のように IsLoaded プロパティを使って調べています。
If CurrentProject.AllForms("frmProcedure1").IsLoaded = False Then

CurrentProject
オブジェクトは、カレント プロジェクト (.adp) またはデータベース (.mdb) に対するプロジェクト (プロジェクト : 標準モジュールおよびクラス モジュールを含む、データベースのすべてのコード モジュールの集合。既定では、プロジェクトの名前はデータベースの名前と同じです。)を参照します

AllFormsはここではCurrentProjectオブジェクトに含まれるコレクションのひとつで、名前の通りすべてのフォームのこと。
IsLoadedはAccessObjectのプロパティ。ロードされているかどうかをBoolean型の値で返します。
下のコードは、これとは別に、SysCmdメソッドを使って同じ事をしています。
Const conObjStateClosed = 0
Const conDesignView = 0
If SysCmd(acSysCmdGetObjectState, acForm, "frmProcedure1") <> conObjStateClosed Then
  'If Forms("frmProcedure1").CurrentView = conDesignView Then 'こちらがオリジナル
  'If Form_frmProcedure1.CurrentView = conDesignView Then 'こちらはアレンジ。これでもOK

  If Forms!frmProcedure1.CurrentView = conDesignView Then 'こちらもアレンジ。これでもOK
    MsgBox "frmProcedure1がデザインビューでオープンされています"
    DoCmd.OpenForm "frmProcedure1"
  End If
Else
  MsgBox "frmProcedure1がオープンされていません" & vbCrLf & "オープンします。"
  DoCmd.OpenForm "frmProcedure1"
End If
ここではフォームを指定する方法をいくつかやってみました。どれを使っても同じ事なのですが、わかりにくいところです。
いずれにしても、アプリケーションの中では、他の特定のフォームがオープンしているかどうかをチェックする必要は頻繁にあるので、下のようなユーザー定義関数が使われるようです。分かりにくいコマンドラインを目にすることなく、結果だけが返ればそれでいいわけです。
Function IsLoaded(ByVal strFormName As String) As Boolean
' 指定したフォームがフォーム ビューまたはデータシート ビューで開かれている場合 True を返します。
  Const conObjStateClosed = 0
  Const conDesignView = 0
  If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> conObjStateClosed Then
    If Forms(strFormName).CurrentView <> conDesignView Then
      IsLoaded = True
    End If
  End If
End Function
Textプロパティと Valueプロパティ
このサンプルフォームはフォームの「KeyPreview/キーボードイベント取得」プロパティのサンプルなのですが、TextプロパティとValueプロパティの違いを理解するためにも面白いです。

フォームのKeyPreviewを Yes/True/はい にすると、キー入力をコントロールが受け取る前にフォームが受け取るようになります。このサンプルもそのように設定しないと正しく動きません。
ふたつのテキストボックスに値が入力されるとOKボタンが使用可能になります。
Option Compare Database
Option Explicit
Private Sub Form_Open(Cancel As Integer)
  Me.cmdOK.Enabled = False
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  Select Case Me.ActiveControl.Name
    Case "txtUserName"
      If Me.ActiveControl.Text = "" Or IsNull(Me.ActiveControl.Text) Or _
        Me.txtPassword.Value = "" Or IsNull(Me.txtPassword.Value) Then
        cmdOK.Enabled = False
        Exit Sub
      End If
    Case "txtPassword"
      If Me.ActiveControl.Text = "" Or IsNull(Me.ActiveControl.Text) Or _
        Me.txtUserName.Value = "" Or IsNull(Me.txtUserName.Value) Then
        cmdOK.Enabled = False
        Exit Sub
      End If
    Case Else
      Exit Sub
  End Select
  cmdOK.Enabled = True
  Exit Sub
End Sub
キーボードからテキストボックスに文字を入力すると、Textプロパティに文字が入ります。このプロパティの特徴はそのコントロールにフォーカスが当たっている間だけ、ということです。フォーカスが移動すると値を書き込んだり読み込んだりはできない。
そして、フォーカスが移動したり保存ボタンを押すとValueプロパティに値が渡される。
Valueプロパティは他のコントロールにフォーカスがあっても値を参照したり変更したりできる。なにげなく使っているテキストボックスですが、細部を見るとこのような細かなルールがあります。
このサンプルコードではこのふたつのプロパティを使い分けています。Valueプロパティは省略して Me.txtPassword="" でもOkです。
if文でIsNullと""でチェックしてますが、テキストボックスの初期値はNullで、書き込んだ文字列を削除すると長さ0の文字列""になるからです。
MeキーワードとCodeContextObjectプロパティ
上のコードの中でも使われているキーワードMeは正確な定義がわかりませんが、カレント・フォームを指すようです。ヘルプの説明によると「現在コードが実行されているクラスを指定するために使われる」ということです。
CodeContextObjectも同じようにコードを実行しているオブジェクトを参照するものですが、標準プロシージャのなかでも使える、というところがMeとの大きな違いです。
以下のコードは上のサンプルフォームのOKボタンのクリックイベントに追加して動作を確認できます。このコード自体はヘルプのなかに使用例として掲載されているものです。ユーザー定義関数はここではフォーム・プロシージャのなかに入れてしまいましたが、標準モジュールのなかに置くものです。
Private Sub cmdOK_Click()
  On Error GoTo cmdOK_Err
  Error 11          ' ゼロによる除算のエラーを生成します。
  Exit Sub
cmdOK_Err:
    If ErrorMessage("cmdOK_Click() Event ", vbYesNo + vbInformation, Err) = vbYes Then
      Exit Sub
    Else
      Resume
    End If
End Sub

Function ErrorMessage(strText As String, intType As Integer, _
    intErrVal As Integer) As Integer
  Dim objCurrent As Object
  Dim strMsgboxTitle As String
  Set objCurrent = CodeContextObject
  strMsgboxTitle = "オブジェクトのエラー " & objCurrent.Name
  strText = strText & "エラーコード #" & intErrVal & " が " & objCurrent.Name & "に発生しました。"
  ErrorMessage = MsgBox(strText, intType, strMsgboxTitle)
  Err = 0
End Function


Page Topへ戻る