getSQL

この関数は、INSERT 及び UPDATE 用の SQL 文を自動的に作成します。

私のスタイルでは ACCESS にはリンクテーブルを作りますが、データの読み出し専用にしておき、更新は PostgreSQL へ直接 SQL を発行するようにしています。 また、実際のデータの編集及び新規追加は、レコードソースの連結していない単票フォームでデータを編集/入力し、そのデータを元に SQL 文を作り発行、という手順になります。
そんな時、更新用の SQL を全部書くのは面倒ですし、結構間違いが多いので、自動的に SQL を書いてくれる関数を作りました。

で、例えば「保存」ボタンなどをクリックしたときにこの関数を呼出すことで、指定したテーブルのフィールド名を読み込んで、フォーム上の同じ名前のフィールドのデータを使用して SQL 文を作って返してくれます。 この時、フォームにはテーブルと同じ名前のフィールドがなければなりません。
そんなに大掛かりなコードではないので、自分で作ってもそんなに手間の掛かるものではありませんが、良ければ参考にしてください。
でも、これだけのコードでもSQL作成の手間はかなり減りますよ(^^

この関数は次のような場合に使用できると思います。

• リンクテーブルが PostgreSQL テーブルと同じ名前で定義されている。
• 単票フォームに 1 レコードのデータを表示しており、そのデータフィールドは非連結フィールドである。
• フィールドは、元になるテーブルと同じ名前で作られており、テーブルのフィールドが全て存在する。
• id という名前のフィールドがあり、これが serial 型で定義されている。 また、UPDATE の場合はコードの中で id を指定できる。
• ACCESS2000 で動作しています。ACCESS97 でも動くと思います。また、ADO ではなく DAO を使用してください。

引数の説明と使い方

引数	型	説明
tdfName	string	フィールド名を取得するテーブルを指定します。 このテーブル名はリンク/postgresテーブルの名前を渡します。尚、テーブル名は両方同じである必要があります。
frm	string	データを読み込んでくるフォーム名を指定します
mode	string	SQLを作成するモードを文字列で渡します UPDATE文の場合には -u 、INSERTの場合には -i を渡してください。
keyID	long	UPDATの場合のみ必須です。WHERE句に使用するidを指定します。

関数は、レコードを保存する前に呼出してください。
ま、当然ですけど。戻り値を文字列で受けて、 パススルークエリや ODBC ワークスペースなどで発行すればデータが更新できるはずです。
尚、エラーが発生した場合は、メッセージボックスが表示され、戻り値には ERROR が文字列で返ります。 ま、コード読んでもらえば使い方はすぐにわかるでしょう(^^

getSQL - コード

Function getSQL(tdfName As String, frm As String, mode As String, Optional keyID As Long = 0) As String

'===========================================================================
'指定したフォームとテーブルを利用して、SQL文を作成する
'(c)koano,2002 - version 0.10 lastupdate 2002/05/03
'===========================================================================
On Error GoTo onError
  Dim i As Integer, j As Integer
  Dim tdf As TableDef, fld As Field
  Dim fName As String, fVal As Variant
  Dim SQL As String, SQL1 As String, SQL2 As String
  Dim msg As String, CR As String: CR = Chr(13) & Chr(10)

  getSQL = "ERROR"  '戻り値の初期値

'引数の確認
  If (keyID = 0) And (mode = "-u") Then
    msg = "keyID を省略したUPDATE文は作れません"
    GoTo echoErrMes
  End If

'フィールド数を数える
  i = CurrentDb.TableDefs(tdfName).Fields.Count

'処理分岐
  Select Case mode
    Case "-u": GoTo makeUPDATE
    Case "-i": GoTo makeINSERT
    Case Else
      msg = "無効なスイッチ" & mode
      GoTo echoErrMes
  End Select
Exit Function

'INSERT文を作る
'================================================================
makeINSERT:
  For j = 0 To i - 1
    GoSub getNameAndValue

    If fName <> "id" Then
      SQL1 = SQL1 & fName & ", "

      If IsNull(fName) Then
        SQL2 = SQL2 & "NULL, "
      Else
        SQL2 = SQL2 & "'" & Forms(frm)(fName) & "', "
      End If
    End If
  Next

  SQL = "INSERT INTO " & tdfName & " ( " & Left(SQL1, Len(SQL1) - 2) & ") VALUES( " & Left(SQL2, Len(SQL2) - 2) & " ) ;"
  getSQL = SQL
Exit Function


'UPDATE文を作る
'================================================================
makeUPDATE:
  For j = 0 To i - 1
    GoSub getNameAndValue

    If fName <> "id" Then
      If IsNull(fVal) Then
        SQL1 = SQL1 & fName & " = NULL, "
      Else
        SQL1 = SQL1 & fName & " = '" & fVal & "', "
      End If
    End If
  Next

  SQL1 = " SET " & Left(SQL1, Len(SQL1) - 0)
  SQL = "UPDATE " & tdfName & SQL1 & " WHERE id = " & keyID & " ;"
  getSQL = SQL
Exit Function

getNameAndValue:
'フィールド名を取得し、フォーム上のデータを読むサブルーチン
'================================================================
  fVal = Null
  fName = CurrentDb.TableDefs(tdfName).Fields(j).Name
  fVal = Forms(frm)(fName)
  Return

onError:
  Select Case Err.Number
    Case 3265
      msg = "存在していないテーブルを参照した、又はその他のエラー" & CR & "( Vars.tdfName = '" & tdfName & "' )"
    Case 2450
      msg = "存在していないフォームを参照した、又はその他のエラー" & CR & "( Vars.frm = '" & frm & "' )"
    Case 2465
      msg = "存在していないフィールドを参照した、又はその他のエラー" & CR & "( Vars.fName = '" & fName & "' )"

    Case Else
      msg = "一般エラー?予想していないエラーかも(^^;;;"
  End Select

echoErrMes:
  msg = msg & CR & CR & "Error Number: " & Err.Number & CR & Err.Description
  MsgBox msg, vbCritical, "getSQL - Error"
  Exit Function
End Function