転ばぬ先の杖程度。
'----------------------------------------------------------------------
' Sub : gsub_SaveAsText
' 全てのオブジェクトをテキストとして保存する
' 復旧にはLoadFromTextを用いる
' 例) LoadFromText acDataAccessPage, "", "ファイルパス"
'----------------------------------------------------------------------
Public Sub gsub_SaveAsText()
Dim obj As Object
Dim i As Long
Dim strDir As String
Dim strName As String
Dim tdf As TableDef
Dim qdf As QueryDef
On Error Resume Next
strDir = CurrentProject.Path & "\SaveAsText\"
If (PathIsDirectory(strDir) = False) Then
MkDir strDir
End If
'---< TABLE >
SaveAsText acDataAccessPage, "", strDir & "Tables" & gcntExtensionTxt
'---< QUERY >
For Each qdf In CurrentDb.QueryDefs
strName = qdf.Name
If Not (Left(strName, 1) = "~") Then
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acQuery, strName, strDir & strName & gcntExtensionTxt
End If
Next qdf
'---< FORM >
For i = 0 To CurrentProject.AllForms.Count - 1
strName = CurrentProject.AllForms(i).Name
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acForm, strName, strDir & strName & gcntExtensionTxt
Next i
'---< REPORT >
For i = 0 To CurrentProject.AllReports.Count - 1
strName = CurrentProject.AllReports(i).Name
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acReport, strName, strDir & strName & gcntExtensionTxt
Next i
'---< MACRO >
For i = 0 To CurrentProject.AllMacros.Count - 1
strName = CurrentProject.AllMacros(i).Name
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acMacro, strName, strDir & strName & gcntExtensionTxt
Next i
'---< MODULE >
For i = 0 To CurrentProject.AllModules.Count - 1
strName = CurrentProject.AllModules(i).Name
SysCmd acSysCmdSetStatus, strName & " Exporting..."
SaveAsText acModule, strName, strDir & strName & gcntExtensionTxt
Next i
'---< END >
MsgBox "Done.", vbInformation
End Sub
'---< データベースウィンドウ非表示 >
DoCmd.SelectObject acForm, Me.Name, True
DoCmd.RunCommand acCmdWindowHide
フォームに記述する場合のサンプル。 先にSelectObjectで自分自身を選択しておくのがミソ。
下の例ではmcntDetail(定数),mrst!ItemName(レコードセットから取り出した品名)を60byteまで削るか、60byte以下ならスペースで補完して返す。 固定長テキストの作成時のサンプル。
Dim i As Long
Dim strTemp As String
Dim str As String
strTemp = mcntDetail & " " & mrst!ItemName
i = LenB(StrConv(strTemp, vbFromUnicode))
If (i > 60) Then
Do Until (i <= 60)
strDetail = Left(strTemp, Len(strTemp) - 1) 'LENで削り、LENBでカウント
i = LenB(StrConv(strTemp, vbFromUnicode)) '全角文字がLENBで切断されるとNULL文字が発生する
Loop
End If
i = 60 - LenB(StrConv(strTemp, vbFromUnicode)) '不足分を補完
str = str &strTemp & Space(i) 'ぴったり60Byteに
人の目には同じような空のコントロール、あるいはフィールドに見えても、
実際にはNull、Empty、ゼロ桁文字列などの別の値が格納されていることがある。
フォーム上で省略不能項目のチェックを行ったり、レコードセット上で値の有無をチェックしたいとき、
汎用の関数を定義していると便利だ。
以下の関数を定義し、「gfnc_value(調べたい値 or コントロール名)=True」なら何か値が入力されている。
'--------------------------------------------------
' Function : gfnc_Value
' 入力チェック
' varValue : 処理文字列
'--------------------------------------------------
Public Function gfnc_Value(ByVal varValue As Variant) As Boolean
If (IsEmpty(varValue) = True) Then
Exit Function
End If
If (IsNull(varValue)) Then
Exit Function
End If
If (varValue = vbNullString) Then
Exit Function
End If
If (StrComp(varValue, "") = 0) Then
Exit Function
End If
'---< CHECK OK >
gfnc_Value = True
End Function
vbNullStringについての判別は、StrCompを用いた「""(ゼロ桁文字列)」の判別より前におくべきである(2007-05-15修正)。 でないと、InputBoxでキャンセルした返り値で実行時エラー5が発生する。 InputBoxの返り値は空でOKしたものもキャンセルで回避したものもvbNullStringと判断されるが、 これを区別する場合にはStrPtr関数を使う。
VBAから任意の名称のテーブルを削除する。
DoCmd.DeleteObject acTable, "テーブル名"
データベースmdb内に任意名のテーブルがあるかどうかを調べる。 テーブルを処理毎に作り直す等の場合に利用する。
'----------------------------------------------------
' Function : Table-Exist-Check
'----------------------------------------------------
Public Function gfnc_ExistTable(ByVal strTableName As String) As Boolean
Dim dbs As Database
Dim rst As Recordset
Dim tdf As TableDef
Set dbs = CurrentDb
'---< LOOP TABLEDEFS >
For Each tdf In dbs.TableDefs
If (tdf.Name = strTableName) Then
gfnc_ExistTable = True
Exit For
End If
Next tdf
End Function
gfnc_ExistTable("テーブル名")がTrueを返せば、その名称のテーブルが存在する。
