Access2016 構文エラー

質問

お世話になります。
Access2003から2016へDB変更（MDB→ACCDB）をしたのですが、構文エラーになります。

2003の時には、エラーなど出ませんでしたが、エラー修正箇所を見ても、エラー該当が無いかと考えております。
どなたか、情報下さると有難く思います。

Private Sub ページヘッダー_Print(Cancel As Integer, PrintCount As Integer)
Me.Section(acPageHeader).Visible = (Me!txtCnt <> 1)
On Error GoTo err_shori
'頁のカウント
If preNo <> 得意先CD Or intP = Pkei Then intP = 0
intP = intP + 1
txt頁 = "P. " & intP '明細30行で１頁

Dim rst As Recordset, strSQL As String
If intP < 2 Then
txt前回請求額.Visible = True
txt入金額.Visible = True
txt繰越金額.Visible = True
txt税抜.Visible = True
txt消費税.Visible = True
txt税込.Visible = True
txt今回請求額.Visible = True
'請求金額等の取得 Q請求金額一覧より
Set rst = db.OpenRecordset("Q請求金額一覧")
rst.FindFirst "得意先CD='" & 得意先CD & _
"' and 締切日 = #" & Format(締切日, "yyyy/mm/dd") & "#"
If Cur_ing 得意先CD & _
rst("最大化表示",m)

　どうも、「Private Sub ページヘッダー_Print(Cancel As Integer, PrintCount As Integer)　」と、最後の 「 If Cur_ing 得意先CD & _」　「 rst("最大化表示",m)」にて、構文エラーになるようです。

回答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()とコードを比較されたし！

お礼

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

回答No.6

wormhole

#3です。
補足見ましたけど
質問の最後の

>If Cur_ing 得意先CD & _
>rst("最大化表示",m)

に当たる部分からおかしくないですか？
文字化けかなにかでコードそのものが壊れているように見えるんですけど。

補足

アドバイス有難う御座います。
投稿するときに、一部表示が壊れているものや、DBをコンバートするときに化け文字になっているものは、現状確認していました。

只今、確認中です。

回答No.5

山田 太郎（@f_a_007）

【補足の補足】フィールド値を取得するコードに関するテスト

回答No.4

山田 太郎（@f_a_007）

【補足】
Dim R As Integer ' ?s?C???f?b?N?X
Dim N As Integer ' ?s???? - 1
' Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset

Dim cnn は不要でしたね。

先のエラーの原因ですが・・・。それは、ADODBを利用した関数,DBLookup()を参照されたし。

.Field(index)
.rst(index)

という構文でフィールド値を取得していますよね。Access 2016 のADODB では、このルールが変更されたのでしょうか？

Public Function DBLookup(ByVal strQuerySQL As String) As Variant
On Error GoTo Err_DBLookup
　　Dim DataValue
　　Dim rst As ADODB.Recordset

　　Set rst = New ADODB.Recordset
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　.MoveFirst
　　　　　　DataValue = .Fields(0)
　　　　End If
　　End With
Exit_DBLookup:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBLookup = Nz(DataValue, ReturnValue)
　　Exit Function
Err_DBLookup:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _
　　　　　 "・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　 "・SQL Text=" & strQuerySQL, _
　　　　　 vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBLookup
End Function

回答No.3

wormhole

access VBAは触ったことありませんが
エラーメッセージには何と出力されていたのでしょうか？

それと問題はこの辺りにあるんだろうと抜粋されてるのだと思いますけど、
その部分だけ見せられてもSubプロシジャやIf分の開始・終了が揃っていないとかの回答になるんじゃないかと思いますけど

Sub プロシジャ名(引数 As 型, ...)
～
End Sub

If 条件式 Then
～
End If

補足

お世話になります。

エラー箇所の全文が下記になります。
Option Compare Database
Option Explicit
Dim db As Database
Dim intP As Integer '頁
Dim preNo As String '得意先CD
Dim Pkei As Integer '頁合計
Dim flgPrint As Boolean '頁の印刷

Private Sub Report_Open(Cancel As Integer)
DoCmd.Maximize
Set db = CurrentDb
lblHikae.Visible = flgHikae
End Sub

Private Sub Report_NoData(Cancel As Integer)
MsgBox "データがありません", vbInformation: End
End Sub

Private Sub Report_Close()
On Error Resume Next
If DFirst("最大化表示", "MT各種設定") Then DoCmd.Maximize Else DoCmd.Restore
db.Close: Set db = Nothing
End Sub

Private Sub ページヘッダー_Print(Cancel As Integer, PrintCount As Integer)
Me.Section(acPageHeader).Visible = (Me!txtCnt <> 1)
On Error GoTo err_shori
'頁のカウント
If preNo <> 得意先CD Or intP = Pkei Then intP = 0
intP = intP + 1
txt頁 = "P. " & intP '明細30行で１頁

Dim rst As Recordset, strSQL As String
If intP < 2 Then
txt前回請求額.Visible = True
txt入金額.Visible = True
txt繰越金額.Visible = True
txt税抜.Visible = True
txt消費税.Visible = True
txt税込.Visible = True
txt今回請求額.Visible = True
'請求金額等の取得 Q請求金額一覧より
Set rst = db.OpenRecordset("Q請求金額一覧")
rst.FindFirst "得意先CD='" & 得意先CD & _
"' and 締切日 = #" & Format(締切日, "yyyy/mm/dd") & "#"
If Cur_ing 得意先CD & _
rst("最大化表示",m)

Attribute& Format(締切日d.Restore
db.Clos請求金額一覧より "・ vbInformation: End"
End Sub

ラ.金額EndS 金額の合計 tble = True
"FROM Sub
INNER JOIN Sub

ラ ON Sub
z一覧よあ・Sub

ラ.一覧よ tble = True
"GROUP BY db.Clos請求金額一覧より"・ vbリ日 = #" & For = TruHAVING 翌謔日リ日ナ１頁

&リa =
Dim ON'EndS
Dim & 金額の合計 tb' ORD "Frue翌謔日re
db.Cl; = True先CD金額=mat(claree締切日, (" If Cur_ing rstg 'db(締切日, ".Refreshved = & "#Clerived = '売上 "' and 切日 = #" & Format(締切日, "yyyy/mm/ ") & "#"
If Cu売上g 得意先CD & _
rst("最df化表示",m)

AtFalse
Attribute& "rmat(締切日d売上tore売上.売上Clo得意°煌z得意°り"・ vbInform売上n: End
End Sub

ラ.金額EndS 金額の
Att
Att
ble = T売上
"FROM S売上n: ER JOI売上.売上Cl ON 売上n: E.売上Cl EndS 金額の合計 "le = True
売上tore売上.売上Clo得意°煌z得意°り"・ vbリ日 金額の合計 tbHAVING 売上toリ日ナ１頁

&リa =
m p ON'EndS
Dim & 金
Att
Att

Att"' ORD "Frue売上tore売上.売上CO; = True先CD金額=mdb(claree締切日, (" If Cu売上" rstg 'db(締切日, s.Refreshved = & "#Clerived = 先CD金額=mb
hingved = F If Cur_inサブ.Sourc FoF If Cur_inサブ = TrueF If Cu売上サブ.Sourc FoF If Cu売上サブ = Trueved = '利益.金鰍ニ利益率の計算ved = Openrst.FinRecordsese
AttOpencurGenka.Fin 得意芯y, curUrntege 得意芯yved = '（翌謔.金梶jved = ナ１ute& Format(締nform If Cur_innd
E
ラ.金穫d Sub

ラ.金・
ラ.金額le = T If Cur_in; = True先CDrst.=mat(OpenRecordses(ナ１uteg 'curGenka.= Nz(rst![b

ラ.金・
ラ.金馨, 0g 'rst.Clerived = '（売上.金梶jved = ナ１ute ON"rmat(締nform If Cu売上nd
E
ラ.金穫d Sub
額
ラ.金・
ラ.金・le = T If Cu売上; = True先CDrst.=mdb(OpenRecordses(ナ１uQLg 'curUrnt= Nz(rst![b

ラ.旧v

回答No.1

catpow

＞＞Access2003から2016へDB変更（MDB→ACCDB）をしたのですが、構文エラーになります。

Accessに限りませんけど、いろんな言語で、バージョンアップしたら動かなくなることはよくあります。
ですので、そういう場合は、ソフト会社に依頼し、数十万から数百万などのお金を支払って修正してもらってください。

ただ、ソフト会社によっては、金額が小さいし、その割りに手間がかかるから、引き受けないという会社もあるようですが。