currentdb.execute sql$
これがあかん、、何で？
しゃなしで、ADOに直した、、
▼仕様例 runsql sql$
''' SQLの簡易実行
Public Function runSql(ByVal sql As String, ParamArray parray()) As Long
' objLog.Debg "runSql" & sql
Dim cmd As New ADODB.Command: Set cmd = New ADODB.Command
With cmd
.ActiveConnection = CurrentProject.Connection
.CommandText = sql
.Prepared = True
If UCase(Left(sql + Space(2), 2)) = "Q_" Then
.CommandType = adCmdStoredProc
End If
Dim val
For Each val In parray
AddCmdParam cmd, val 'パラメタ設定
Next
.Execute (runSql)
End With
End Function
''' パラメタ設定
Public Sub AddCmdParam(cmd As ADODB.Command, val, Optional dTYPE As ADODB.DataTypeEnum = 0, Optional dsize As Long = 0, Optional pType As ADODB.ParameterDirectionEnum = adParamInput)
On Error GoTo LBL_999
Dim param As ADODB.Parameter
Dim myDtype As ADODB.DataTypeEnum
If dTYPE = 0 Then
Select Case VarType(val)
Case vbInteger, vbLong
myDtype = adInteger
Case vbSingle, vbDouble
myDtype = adDouble
Case vbDate
myDtype = adDBTimeStamp
Case vbCurrency
myDtype = adCurrency
Case vbNull
myDtype = adEmpty
Case Else
myDtype = adVarWChar
End Select
Else
myDtype = dTYPE
End If
If dsize = 0 Then
Select Case myDtype
Case adVarWChar
Dim vLen As Long: vLen = Len(val)
If vLen = 0 Then
vLen = 1
End If
Set param = cmd.CreateParameter(, myDtype, pType, vLen, val)
Case adDBTimeStamp
Set param = cmd.CreateParameter(, myDtype, pType, , CDate(val))
Case adEmpty
Set param = cmd.CreateParameter(, myDtype, pType, , Null)
Case Else
Set param = cmd.CreateParameter(, myDtype, pType, , val)
End Select
Else
Set param = cmd.CreateParameter(, myDtype, pType, dsize, val)
End If
cmd.Parameters.Append param
Exit Sub
LBL_999:
' MsgBox Error(ERR)
Debug.Print "AddCmdParam", (Err.Description)
objLog.Error (Err.Description)
End Sub
