BANSYSTEMSBLOG

AccessVBAで構築したデータベースだが、追加要望が頻繁にあるため、いい加減配付に疲れた。しかもあまりに更新が頻繁なため、バージョン違いのエンドユーザが存在した。かといって、ショートカットでサーバーのAccessファイルを開いては処理速度が遅くなる。（以前はこんな使い方をしていたらしい。案の定、mdbが開けなくなり、復旧に苦労したという話である。）
エンドユーザのデスクトップにWSHをおいてもらうことにした。
そのスクリプトを実行するとサーバーmdbをローカルにコピーしてその後起動する。とりあえずこの処理に落ち着いたのだが、なにか他にいい方法があれば教えてくだせー。あと調べればいいのだが、WSHで二重起動防止するってことできるのかな？時間があれば調べます。
Dim fs
Set fs = CreateObject(”Scripting.FileSystemObject”)
Set WSHShell = WScript.CreateObject(”WScript.Shell”)
if fs.FileExists(”C:\TEST.ldb”) then
ib = WSHShell.Popup (”データベースは開かれてますか？”,5,,vbYesNo)
if ib = vbyes or ib = -1 then
WScript.Quit
end if
end if
fs.CopyFile “\\ホスト名\d_drive\DATA\TEST.mdb”,”C:\”,True
WScript.Sleep 2000
WSHShell.Run “C:\TEST.mdb”
WSHShell.Popup “TESTデータベースを起動します。このメッセージは自動的に消去します。”,3,,vbInfomation

以前から作っていたAccessのデータベースが導入されました。
よくある話だと思いますが、導入してから、あれやこれや要望が沢山来ます。
もう慣れましたけど。。
ちなみに、印刷の時がわかりづらいのでコマンドバーを独自に作成し、印刷ボタンとページ設定のみ表示させておいて他のツールバーは一切消すことにしました。
以前はプレビューをした時点で印刷プレビューのツールバーだけ表示させていましたが、余計なものはいらないということで作成することにしました。
クラスは以前から作っていたので変更処理はスムーズでした。
以下自作のクラスです。
Option Explicit
Dim MyBar As CommandBar
Dim TopMenu As CommandBarPopup
Dim barName As String
‘初期化
Private Sub Class_Initialize()
On Error Resume Next
‘ツールバーが存在時は削除する
Application.CommandBars(barName).Delete
End Sub
‘コマンドバーの名前を取得
Property Let setBarName(Name)
barName = Name
End Property
Property Get getBarName()
getBarName = barName
End Property
‘コマンドバーの作成
Sub setCommdBarsAdd()
‘コマンドバーの作成
Set MyBar = CommandBars.Add(barName, msoBarTop)
MyBar.Visible = True
End Sub
‘ボタン作成
Function SetButton(strCaption As String)
Dim varName As CommandBarButton
Set varName = CommandBars(barName).Controls _
.Add(msoControlButton)
With varName
.Caption = strCaption
.Style = msoButtonCaption
End With
End Function
‘ポップアップ作成
Function SetPupup(strCaption As String)
Set TopMenu = CommandBars(barName).Controls _
.Add(msoControlPopup)
TopMenu.Caption = strCaption
End Function
‘サブボタン
Function SetSubButton(strCaption As String)
Dim SubBtn As CommandBarButton
With TopMenu
Set SubBtn = .Controls.Add(msoControlButton)
End With
SubBtn.Caption = strCaption
End Function
‘サブメニュー
Function SetSubMenu(strCaption As String)
Dim SubMenu As CommandBarPopup
With TopMenu
Set SubMenu = .Controls.Add(msoControlPopup)
End With
SubMenu.Caption = strCaption
End Function
‘区切り線
Function SetGroup(barName As String, ctlName As String)
CommandBars(barName).Controls(ctlName).BeginGroup = True
End Function
‘プロシージャの登録
Function SetProceduce(ctlName As String, atnName As String)
CommandBars(barName).Controls(ctlName).OnAction = atnName
End Function
‘消去
Sub setEraceBar()
On Error Resume Next
‘ツールバーが存在時は削除する
Application.CommandBars(barName).Delete
End Sub
クラスで作っておくと何かと便利ですね。

社内にWindows98、2000、XPが混在しているため、クライアント側のバージョンを取得して
特に、98の時に処理を変えたかったのでAPIを使った。
Windows98はもうそろそろ終りにしてもいいんじゃない？
Windows98はいいんだけど、、マシン自体が遅すぎだよ。
自分がそんなこといっちゃいけないんだけど…。
まあ、まだWindows98つかってくれる人がいるから自分はVMWareにWin98を入れて
楽しめる？（テストできる）からいいかな。。それにしてもVMWareとかVirtual PCとか便利だなー。
最近のPCのスペックがいいから速度もどんどん速くなるし。（もちろんソフトも改良されてると思うけど）
いずれはMacですべてのOSが使えるようにしたい。でもMacのVirtual PCは不安定すぎ。
すぐ落ちてしまう。自分がいくら保存マニアだとしても、これじゃプログラミングはできないなーー。
‘ Windowsのバージョンに関する拡張情報を定義する構造体
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion(127) As Byte
End Type
‘ Windows 95もしくはWindows 98であることを示す定数の宣言
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
‘ Windows NTもしくはWindows 2000であることを示す定数の宣言
Public Const VER_PLATFORM_WIN32_NT = 2
‘ Windowsのバージョンに関する拡張情報を取得する関数の宣言
Declare Function GetVersionEx Lib “kernel32.dll” _
Alias “GetVersionExA” _
(lpVersionInformation As OSVERSIONINFO) As Long
Private Sub OSVersion()
Dim udtOSVersionInfo As OSVERSIONINFO
Dim strOSversionInfo As String
Dim lngWin32apiResultCode As Long
‘ バージョンに関する拡張情報の構造体を初期化
With udtOSVersionInfo
.dwOSVersionInfoSize = Len(udtOSVersionInfo)
End With
‘ Windowsのバージョンに関する拡張情報を取得
lngWin32apiResultCode = GetVersionEx(udtOSVersionInfo)
‘ Windowsのバージョンに関する拡張情報を表示
With udtOSVersionInfo
‘ バージョン情報を表示
Debug.Print _
.dwMajorVersion & “.” & _
.dwMinorVersion & _
” (” & _
(.dwBuildNumber And &HFFFF&) & _
“)”
‘ プラットフォームを表示
Select Case .dwPlatformId
Case VER_PLATFORM_WIN32_WINDOWS
Me!lblVersion.Caption = _
“Windows 95 or Windows 98″
Case VER_PLATFORM_WIN32_NT
Me!lblVersion.Caption = _
“Windows NT or Windows 2000″
End Select
End With
End Sub
※VB、VBAでの使用方法。

先日からどっぷりAccessVBAだが、物忘れがひどい。
サブフォームのレコード移動の仕方を忘れたので載せておこう。
Me!サブフォーム名.SetFocus
DoCmd.GoToRecord , , acLast
GoToRecordの後に引数など指定したり、サブフォームにフォーカスをセットしなかったりすると、
「サブフォームが開かれてません」というエラーが出る。
これ３年前にもこんな経験あったな?。いかんいかん。

現在の仕事はハンディターミナルでの在庫管理作業（C#での開発）であるが、レポートの出力はなんと言ってもAccessがいろんな意味で便利。（ハンディターミナルから印刷できるみたいだけど、特に意味はないのでやっていない）
ただ、普通にAccessで設定した書式はPCによってずれることが多い。だからVBAで設定してるんだけど、Access2002からはPrintersコレクションが用意されているらしく（最近知った）、それを使ってみたらえらい簡単だったので載せときます。
今まではPrtDevMode プロパティなどを使って設定してたんだけど、構造体を貼り付けておかなければならなかったりと、興味ない方には分かりづらい部分だった。
‘/*
‘ VBAによるレポートの書式設定
‘*/
Public Function RestoreReportPrinter(strReportname As String) As Boolean
On Error GoTo Err
DoCmd.OpenReport ReportName:=strReportname, _
View:=acDesign, _
WindowMode:=acHidden
With Reports(report1).Printer
.Orientation = acPRORLandscape
.PaperSize = acPRPSA4
.TopMargin = 10
.BottomMargin = 10
.LeftMargin = 10
.RightMargin = 10
End With
DoCmd.Close objecttype:=acReport, objectname:=strReportname, _
Save:=acSaveYes
DoCmd.OpenReport ReportName:=strReportname, View:=acViewPreview
RestoreReportPrinter = True
Exit Function
Err:
RestoreReportPrinter = False
End Function
このまま貼り付けるだけで使えます。おそらくAccess2002以降。Access2000以前でのやり方知りたい人はコメントくだされば載せときます。プロパティなどを選んでF1押せばヘルプが開かれますのでプロパティの詳細はヘルプを読んでみてください。