Sub TrySample_5_1()

  Dim dbs As Database
  Dim qdf As QueryDef

  Set dbs = CurrentDb
  For Each qdf In dbs.QueryDefs
    With qdf
      If Left$(.Name, 4) <> "~sq_" Then
        Debug.Print .Name,
        Select Case .Type
          Case dbQSelect
            Debug.Print "選択クエリ",
            If .Parameters.Count = 0 Then
              Debug.Print "パラメータなし"
            Else
              Debug.Print "パラメータあり"
            End If
          Case dbQAppend
            Debug.Print "追加クエリ"
          Case dbQUpdate
            Debug.Print "更新クエリ"
          Case dbQDelete
            Debug.Print "削除クエリ"
          Case Else
            Debug.Print "その他"
        End Select
      End If
    End With
  Next qdf

End Sub

Sub TrySample_5_2()

  Dim dbsServer As Database
  Dim dbsLocal As Database
  Dim strConStr As String
  Dim qdf As QueryDef
  Dim strQdfSQL As String
  Dim strSQL As String
  Dim strPrmName As String
  Dim strPrmType As String

  strConStr = "ODBC;DRIVER=SQL Server;" & _
              "SERVER=NAFUREI;" & _
              "DATABASE=UpSizeTest;" & _
              "Trusted_Connection=Yes;"

  On Error GoTo Err_Handler

  'SQL Server上のUpSizeTestデータベースに接続
  Set dbsServer = OpenDatabase("", False, False, strConStr)

  Set dbsLocal = CurrentDb
  For Each qdf In dbsLocal.QueryDefs
    strSQL = ""
    With qdf
      If Left$(.Name, 4) <> "~sq_" Then
        'SQLプロパティを取得（最後の;を除去）
        strQdfSQL = Replace(.SQL, ";", "")

        'AccessとSQL Serverの文法の違いを変換
        strQdfSQL = Replace(strQdfSQL, "&", "+")
        strQdfSQL = Replace(strQdfSQL, """", "'")
        strQdfSQL = Replace(strQdfSQL, "True", "1")
        strQdfSQL = Replace(strQdfSQL, "False", "0")

        'ORDER BY句があるときはTOP句を追加
        If InStr(strQdfSQL, "ORDER BY") > 0 And InStr(strQdfSQL, " TOP ") = 0 Then
          strQdfSQL = Replace(strQdfSQL, "SELECT ", "SELECT TOP (100) PERCENT ")
        End If

        'クエリの種類による分岐
        Select Case .Type
          Case dbQSelect
            If .Parameters.Count = 0 Then
              '選択クエリ（パラメータなし）
              strSQL = "CREATE VIEW " & .Name & " AS " & strQdfSQL

            Else
              '選択クエリ（パラメータあり）
              strPrmName = "@" & Replace(Replace(.Parameters(0).Name, "[", ""), "]", "")
              Select Case .Parameters(0).Type
                Case dbText: strPrmType = "nvarchar(255)"
                Case dbByte: strPrmType = "tinyint"
                Case dbInteger: strPrmType = "smallint"
                Case dbLong: strPrmType = "int"
                Case dbSingle: strPrmType = "real"
                Case dbDouble: strPrmType = "float"
                Case dbDate: strPrmType = "datetime"
                Case dbCurrency: strPrmType = "money"
                Case dbBoolean: strPrmType = "bit"
              End Select
              strQdfSQL = Replace(strQdfSQL, .Parameters(0).Name, strPrmName)
              strSQL = "CREATE FUNCTION " & .Name & _
                        " (" & strPrmName & " " & strPrmType & ") " & _
                        "RETURNS TABLE AS " & _
                        "RETURN (" & strQdfSQL & ")"

            End If

          Case dbQAppend, dbQUpdate
            '追加／更新クエリ
            strSQL = "CREATE PROCEDURE " & .Name & " AS " & _
                      "BEGIN " & strQdfSQL & " END"

          Case dbQDelete
            '削除クエリ
            strQdfSQL = "DELETE " & Mid(strQdfSQL, InStr(strQdfSQL, "FROM"))
            strSQL = "CREATE PROCEDURE " & .Name & " AS " & _
                      "BEGIN " & strQdfSQL & " END"

        End Select
      End If
    End With

    If strSQL <> "" Then
      'SQL文をSQL Serverに発行
      dbsServer.Execute strSQL, dbSQLPassThrough
    End If

  Next qdf

Exit_Here:
  Exit Sub

Err_Handler:
  MsgBox "エラー番号：" & Err.Number & vbCrLf & vbCrLf & _
         "エラー内容：" & Err.Description, vbOKOnly + vbCritical
  Resume Exit_Here:

End Sub