Access2016 構文エラー - 解決方法と対策

質問

• Access2016で発生する構文エラーの解決方法について説明します。
• Access2003から2016へのDB変更により、構文エラーが発生する問題が報告されています。
• 特に「Private Sub ページヘッダー_Print(Cancel As Integer, PrintCount As Integer)」部分でエラーが発生しているようです。

回答No.2

山田 太郎（@f_a_007） · ベストアンサー

2000年以来、Access のコードは書いたことがないが・・・。もっと、簡単なコードを書いたがいいような気がしましたので、ちょっとお節介を。

Private Sub ページヘッダー_Print(Cancel As Integer, PrintCount As Integer)
On Error GoTo err_shori
　　Dim intPreNo　 As Integer
　　Dim intP　　　 As Integer
　　Dim intPKei　　As Integer
　　Dim strPage　　As String
　　Dim strSQL　　 As String
　　Dim strReturns As String

　　Me.Section(acPageHeader).Visible = (Me.txtCnt <> 1)
　　' *********************
　　' 頁のカウント
　　' *********************
　　If intPreNo <> 得意先CD Or intP = intPKei Then
　　　　intP = 1
　　　　strPage = "P. " & intP '明細30行で１頁
　　　　Me.txt前回請求額.Visible = True
　　　　Me.txt入金額.Visible = True
　　　　Me.txt繰越金額.Visible = True
　　　　Me.txt税抜.Visible = True
　　　　Me.txt消費税.Visible = True
　　　　Me.txt税込.Visible = True
　　　　Me.txt今回請求額.Visible = True
　　　　'請求金額等の取得 Q請求金額一覧より
　　　　strSQL = "SELECT ・・・・"
　　　　strReturns = DBSelect(strSQL)

いちいち、ADODB のコネクションを確立してSQL文を実行して結果を取得する手続きを書くのは面倒。そういうことをすれば、その都度、バグ取りに終われることになるのでは・・・。それを、回避するには、その一連の手続きを関数化しておくこと。

添付図では、[テーブル1]の[ID]=1のレコード情報をDBSelect()で取得しています。同関数は、１レコードの各列の値を”;”で連結して返します。後は、CutStr()で取り出すだけです。

　どちらも、2000年に書いた関数ですが、Access2016でも通用すると思います。まあ、通用しなかったら、考え方だけでも

【蛇足】int=1 だけで良いのでは・・・

Public Function DBSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　 Optional colDelimita As String = ";", _
　　　　　　　　　　　　 Optional rowDelimita As String = ";") As String
On Error GoTo Err_DBSelect
　　Dim R　　　　　 As Integer ' 行インデックス
　　Dim N　　　　　 As Integer ' 行総数 - 1
　　Dim cnn　　　　 As ADODB.Connection
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strList　　 As String　' 全てのデータを区切子で連結して格納

　　Set cnn = CurrentProject.Connection
　　Set rst = New ADODB.Recordset
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　N = .RecordCount - 1
　　　　　　.MoveFirst
　　　　　　For R = 0 To N
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　strList = strList & .Value & colDelimita
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　strList = Mid(strList, 1, Len(strList) - 1) & rowDelimita
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　Else
　　　　　　strList = ""
　　　　End If
　　End With
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = IIf(Len(strList) > 0, Replace(strList & "[END]", rowDelimita & "[END]", ""), "")
　　Exit Function
Err_DBSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr(13) & Chr(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　　ByVal Separator As String, _
　　　　　　　　　　　　ByVal N As Integer) As String
　　Dim strDatas() As String

　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs(N <= UBound(strDatas)))
End Function

【補足】 rst("最大化表示",m)」にて、構文エラーになるようです。

DBSelect()とコードを比較されたし！

お礼

有難う御座います。
コードを書き直すのは、面倒でしたので、端折ってました。
確認します。