Accessテクニック集 page1

ここで紹介するテクニックは、主にWindows 2000 + Access 2000で動作検証してますm(_ _)m

001.カレント内のクエリーをすべて見つける

002.Shell起動したアプリケーションの終了を検知する

003.ゴミ箱を空にする

004.重複ファイルがあった場合に、追番を付加したファイル名を取得する

005.サブフォーム内で、カレント行が最終行かどうか

006.当月の日数を取得する

007.Excelファイルを開く

008.起動中のExcelをすべて強制的に閉じる

009.フォームをウィンドウの一番上から表示させる

010.Option Compare Databaseの憂鬱





トップ

001.カレント内のクエリーをすべて見つける


Dim CDB As DAO.Database
Dim iQUERY As QueryDef

Set CDB = CurrentDb

For Each iQUERY In CDB.QueryDefs

Debug.Print iQUERY.Name
  • Next iQUERY

トップ

002.Shell起動したアプリケーションの終了を検知する


Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function
WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function
GetExitCodeProcess Lib "kernel32" (ByVal PROCESS As Long, lpExitCode As Long) As Long
Private Declare Function
CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Dim Ret As Long
Dim
PROCESS As Long
Dim
MODORITI As Long
Dim
ENDWORK As Long

Ret = Shell("c:\winnt\System32\calc.exe")

PROCESS = OpenProcess(1024 Or 1048576, True, Ret)
WaitForSingleObject PROCESS, 100000 ' exeが終了するまで待つ

GetExitCodeProcess PROCESS, ENDWORK ' 終了コード取得
CloseHandle PROCESS ' プロセスハンドルを閉じる

トップ

003.ゴミ箱を空にする


Private Declare Function SHEmptyRecycleBin Lib "shell32" Alias "SHEmptyRecycleBinA" (ByVal hWnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long

Const SHERB_NOCONFIRMATION = &H1& '削除時の確認メッセージを表示しない
Const SHERB_NOPROGRESSUI = &H2& '削除のプログレス(進行度)ダイアログを表示しない
Const SHERB_NOSOUND = &H4& '削除終了時サウンドを再生しない

Dim Ret As Long
Dim
Drive As String


'ドライブ指定
'Drive = "" '全ドライブを指定
Drive = "c:\" 'Cドライブを指定

'ごみ箱を空にします
Ret = SHEmptyRecycleBin(Application.hWndAccessApp, Drive, SHERB_NOCONFIRMATION + SHERB_NOPROGRESSUI + SHERB_NOSOUND)


'オプションなし
'Ret = SHEmptyRecycleBin(Application.hWndAccessApp, Drive, 0)

'呼び出しフォームのハンドルを使用
'Ret = SHEmptyRecycleBin(Forms("メインメニュー").hWnd, Drive, SHERB_NOCONFIRMATION + SHERB_NOPROGRESSUI + SHERB_NOSOUND)

トップ

004.重複ファイルがあった場合に、追番を付加したファイル名を取得する


Public Function s004(paraパス As String, paraファイル名 As String) As String

Dim i As Integer
Dim
wkパス As String
Dim
wkファイル名 As String
Dim
wk名前 As String
Dim
wk拡張子 As String

wkパス = paraパス

'ファイル名と拡張子を取得
If
InStr(1, paraファイル名, ".") > 0 Then
wk拡張子 = Mid$(paraファイル名, InStr(1, paraファイル名, "."))
wk名前 = Left$(paraファイル名, Len(paraファイル名) - Len(wk拡張子))

Else
wk名前 = paraファイル名
wk拡張子 = ""

End If

'ファイル名を取得
i = 1
wkファイル名 = paraファイル名

Do

If Dir(wkパス & wkファイル名) = "" Then

Exit Do

End If

i = i + 1

wkファイル名 = wk名前 & "(" & i & ")" & wk拡張子

Loop

'戻り値
s004 = wkファイル名

End Function

トップ

005.サブフォーム内で、カレント行が最終行かどうか


'カレント行が最終行の場合は、次のレコードに移動しない
If Me.CurrentRecord < Me.Recordset.RecordCount Then
DoCmd.GoToRecord , , acNext
End If


トップ

006.当月の日数を取得する


Dim wk当月 As String


wk当月 = Format$(Now, " YYYY/MM") & "/01"

'DATE型の引き算は日数になる
Debug.Print DateAdd("M", 1, wk当月) - CDate(wk当月)


トップ

007.Excelファイルを開く


Dim obtEXCEL As Object

Set obtEXCEL = CreateObject("Excel.Application")

With obtEXCEL

.Visible = False

.Workbooks.Open filename:="C:\Program Files\Microsoft Office\Office\Library\COMMON.XLS"

.Application.Visible = True

End With

Set obtEXCEL = Nothing


トップ

008.起動中のExcelをすべて強制的に閉じる


Dim obtEXCEL As Object

On Error Resume Next

Set obtEXCEL = GetObject(, "Excel.Application")

Err.Clear


Set obtEXCEL = GetObject("c:\vb4\MYTEST.XLS")

obtEXCEL.Application.Visible = True


obtEXCEL.Parent.Windows(1).Visible = True

obtEXCEL.Application.Quit

 

Set obtEXCEL = Nothing


On Error GoTo 0


トップ

009.フォームをウィンドウの一番上から表示させる


'フォームのプロパティでポップアップをTrueに設定し、


'Form_Openに以下を記述

DoCmd.MoveSize , 0



トップ

010.Option Compare Databaseの憂鬱


'モジュール先頭にある「Option Compare Database」には注意が必要です。
' Option Compare Database と Option Compare Binary で比較してみて下さい。

'Databaseの場合大文字小文字の区別がされません。

If "t" = "T" Then

MsgBox """t""=""T""" 'Databaseの場合

Else

MsgBox """t""≠""T""" 'Binaryの場合

End If







NEXT

HOME