Q&A
ベストアンサー
ありがとうございます。
「ODBCデータソース」？？？？。
配布先ＰＣにそれをインストールする必要があるという事でしょうか？。
私は、開発元で色々な設定を行い、accdeにしたものを配布（配布先には無論Ａｃｃｅｓｓのランタイムは必要）すれば、接続してくれるものと認識しておりました。
そのキーワードで調べてみます。
とりあえず、元々リンクテーブルで作ったので、ＳＱＬ－Ｓｅｒｖｅｒでもリンクテーブルで、まずはやってみます。
記載したとおり、メジャーＤＢの経験は全く無いに等しいので、わかるところからチャレンジしてみます。
ちなみに、同一ＰＣ内で試した感じでは、遅いとは全く感じなかったです。別ＰＣから低速といっても、地方拠点に配布するわけではなく、自社のそれこそ同じフロア内の同じセグメント内での数台での利用であるので、さほど気にならないと思います。
パススルークエリーというのが、ネットや本でみても、どのようなものか検討つかず、サーバ側で動いて答えを返すといった事柄を見ると、ＰＬ／ＳＱＬのようなものなのかな？と感じてしまっております。
質問で書いたコードは、最初のトップ画面に記載したもので、トップ画面んから各画面に遷移するイメージとしております。
その中で、例えば社員マスタの画面のコード（修正と削除を抜粋）は、下記のように作っており、同一ＰＣ内（クライアントが面とＤＢ）では、追加修正削除問題なくできてます。
Option Compare Database
Option Explicit
Dim str_getPara() As String
Dim str_OyaGamen As String
Dim str_Mode As String
Dim str_Code As String
'
Private Sub cmd_削除_Click()
Dim ct As New ADODB.Connection
Dim str_Sql As String
Dim i_Umu As Integer
On Error GoTo Err_cmd_削除_Click
'選択チェック
If Trim(txt_社員コード) = "" Or IsNull(txt_社員コード) = True Then
MsgBox "未選択。", _
vbExclamation Or vbOKOnly, "エラー cmd_削除_Click"
Exit Sub
End If
'既に使われている場合、拒否
If F_MasterData_Usu_Check("社員コード", Trim(txt_社員コード), i_Umu) <> 0 Then
Exit Sub
Else
If i_Umu <> 0 Then
MsgBox "削除しようとしたマスタデータは、既に使われてるので、削除できません。", _
vbExclamation Or vbOKOnly, "警告"
Exit Sub
End If
End If
If MsgBox("当データを削除します。いいですか？。", _
vbInformation Or vbYesNo, "確認") = vbNo Then
Exit Sub
End If
'deleate
Set ct = Application.CurrentProject.Connection
ct.BeginTrans
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
''''' str_Sql = "Delete TM_社員マスタ.社員コード"
''''' str_Sql = str_Sql + " FROM TM_社員マスタ"
''''' str_Sql = str_Sql + " WHERE (((TM_社員マスタ.社員コード)='" & Trim(txt_社員コード) & "'));"
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
str_Sql = "Delete dbo_TM_社員マスタ.社員コード"
str_Sql = str_Sql + " FROM dbo_TM_社員マスタ"
str_Sql = str_Sql + " WHERE (((dbo_TM_社員マスタ.社員コード)='" & Trim(txt_社員コード) & "'));"
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Debug.Print str_Sql
ct.Execute str_Sql 'ここでロック開始
ct.CommitTrans 'ここでロック解除
ct.Close
Set ct = Nothing
Me.Requery
''''' Me.Refresh
Err_cmd_削除_Click:
If Err.Number <> 0 Then
ct.RollbackTrans 'ここでロック解除
ct.Close
Set ct = Nothing
MsgBox Err.Description & "(" & Err.Nimber & ")" & vbCrLf & _
"削除できませんでした。" & vbCrLf & _
"既にそのデータは削除されたか確認して下さい。" & vbCrLf & _
"エラーコードとエラーメッセージを控えて下さい。（cmd_削除_Click)", _
vbCritical Or vbOKOnly, "エラー cmd_削除_Click"
End If
End Sub
'
Private Sub cmd_修正_Click()
Dim ct As New ADODB.Connection
Dim RS As New ADODB.Recordset
Dim str_filter As String
Dim str_Sql As String
Dim varBm As Variant 'バリアント型の変数を指定
On Error GoTo Err_cmd_修正_Click
'選択チェック
If Trim(txt_社員コード) = "" Or IsNull(txt_社員コード) = True Then
MsgBox "社員コード未入力。", _
vbExclamation Or vbOKOnly, "エラー cmd_修正_Click"
Exit Sub
End If
If Trim(txt_社員名) = "" Or IsNull(txt_社員名) = True Then
MsgBox "社員名未入力。", _
vbExclamation Or vbOKOnly, "エラー cmd_修正_Click"
Exit Sub
End If
'入力チェック
If Len(txt_社員コード) > 6 Then
MsgBox "商品コードは6桁で入れてください。", _
vbExclamation Or vbOKOnly, "エラー cmd_修正_Click"
Exit Sub
End If
If str_Code <> Trim(txt_社員コード) Then
MsgBox "社員コードは、キー項目なので、修正できません。", _
vbExclamation Or vbOKOnly, "エラー cmd_修正_Click"
Exit Sub
End If
If Len(txt_社員名) > 50 Then
MsgBox "社員名は50桁以内で入れてください。", _
vbExclamation Or vbOKOnly, "エラー cmd_修正_Click"
Exit Sub
End If
If Trim(txt_備考) = "" Or IsNull(txt_備考) = True Then
Else
If Len(txt_備考) > 100 Then
MsgBox "備考は100桁以内で入れてください。", _
vbExclamation Or vbOKOnly, "エラー cmd_修正_Click"
Exit Sub
End If
End If
If InStr(Trim(txt_社員コード), "'") <> 0 Then
MsgBox "シングルコーテーションは使わないでください。", _
vbExclamation Or vbOKOnly, "エラー cmd_修正_Click"
Exit Sub
End If
If InStr(Trim(txt_社員名), "'") <> 0 Then
MsgBox "シングルコーテーションは使わないでください。", _
vbExclamation Or vbOKOnly, "エラー cmd_修正_Click"
Exit Sub
End If
If InStr(Trim(txt_備考), "'") <> 0 Then
MsgBox "シングルコーテーションは使わないでください。", _
vbExclamation Or vbOKOnly, "エラー cmd_修正_Click"
Exit Sub
End If
If MsgBox("当マスタを修正します。" & vbCrLf & _
"名称変更の場合は、使用しているデータも変わってしまいます。" & vbCrLf & _
"いいですか？。", _
vbInformation Or vbYesNo, "確認") = vbNo Then
Exit Sub
End If
varBm = Me.Bookmark '現在レコードの情報を入れる
'Update
Set ct = Application.CurrentProject.Connection
'同一名称チェック
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
''''' RS.Open "TM_社員マスタ", ct, adOpenKeyset, adLockOptimistic
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
RS.Open "dbo_TM_社員マスタ", ct, adOpenKeyset, adLockOptimistic
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
''''' str_filter = "商品名='" & Trim(txt_商品名) & "' and 備考='" & Trim(txt_備考) & "'"
str_filter = "社員名='" & Trim(txt_社員名)
str_filter = str_filter + "' and 備考='" & Trim(txt_備考)
str_filter = str_filter + "'"
RS.Filter = str_filter
If RS.RecordCount <> 0 Then
'同一名称あり
RS.Close
Set RS = Nothing
ct.Close
Set ct = Nothing
MsgBox "既に同じ名称かつ同じ備考内容のデータが存在します。", _
vbExclamation Or vbOKOnly, "注意"
Exit Sub
End If
RS.Close
Set RS = Nothing
ct.BeginTrans
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'''''' str_Sql = "UPDATE TM_社員マスタ SET "
'''''' str_Sql = str_Sql + "TM_社員マスタ.社員名 = '" & Trim(txt_社員名) & "'"
''''''
'''''' If Trim(txt_備考) = "" Or IsNull(txt_備考) = True Then
'''''' str_Sql = str_Sql + ", TM_社員マスタ.備考 = ''"
'''''' Else
'''''' str_Sql = str_Sql + ", TM_社員マスタ.備考 = '" & Trim(txt_備考) & "'"
'''''' End If
''''''
'''''' str_Sql = str_Sql + " WHERE (((TM_社員マスタ.社員コード)='" & Trim(txt_社員コード) & "'));"
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
str_Sql = "UPDATE dbo_TM_社員マスタ SET "
str_Sql = str_Sql + "dbo_TM_社員マスタ.社員名 = '" & Trim(txt_社員名) & "'"
If Trim(txt_備考) = "" Or IsNull(txt_備考) = True Then
str_Sql = str_Sql + ", dbo_TM_社員マスタ.備考 = ''"
Else
str_Sql = str_Sql + ", dbo_TM_社員マスタ.備考 = '" & Trim(txt_備考) & "'"
End If
str_Sql = str_Sql + " WHERE (((dbo_TM_社員マスタ.社員コード)='" & Trim(txt_社員コード) & "'));"
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Debug.Print str_Sql
ct.Execute str_Sql 'ここでロック開始
ct.CommitTrans 'ここでロック解除
ct.Close
Set ct = Nothing
Me.Requery
'''' Me.Refresh
Me.Bookmark = varBm '元のレコードに戻す
txt_社員コード = ""
txt_社員名 = ""
txt_備考 = ""
Err_cmd_修正_Click:
If Err.Number <> 0 Then
RS.Close
Set RS = Nothing
ct.RollbackTrans 'ここでロック解除
ct.Close
Set ct = Nothing
MsgBox Err.Description & "(" & Err.Nimber & ")" & vbCrLf & _
"修正できませんでした。" & vbCrLf & _
"他の方が同じコードを修正中か、既にそのコードは削除されたか確認して下さい。" & vbCrLf & _
"エラーコードとエラーメッセージを控えて下さい。（cmd_修正_Click)", _
vbCritical Or vbOKOnly, "エラー cmd_修正_Click"
End If
End Sub
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/12/11 13:57
2017/12/12 00:33
2017/12/12 14:02