回答編集履歴

4

説明の改善

2020/07/15 15:10

投稿

hatena19
hatena19

スコア34075

test CHANGED
File without changes

3

説明の改善

2020/07/15 15:10

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -27,6 +27,14 @@
27
27
 
28
28
 
29
29
  外部データベース用のDCount関数、DLookup関数
30
+
31
+
32
+
33
+ DCount関数、DLookup関数とまったく同じ仕様なので、
34
+
35
+ 下記のコードを標準モジュールにコピーして、
36
+
37
+ VBAエディターで DCount を MyDCount に置換、DLookup を MyDLoouup に置換するだけです。
30
38
 
31
39
 
32
40
 

2

コード追記

2020/07/15 15:10

投稿

hatena19
hatena19

スコア34075

test CHANGED
File without changes

1

コード追記

2020/07/15 15:07

投稿

hatena19
hatena19

スコア34075

test CHANGED
@@ -19,3 +19,75 @@
19
19
 
20
20
 
21
21
  [テーブルデータを保護する - hatena chips](https://hatenachips.blog.fc2.com/blog-entry-351.html)
22
+
23
+
24
+
25
+ ---
26
+
27
+
28
+
29
+ 外部データベース用のDCount関数、DLookup関数
30
+
31
+
32
+
33
+ ```vba
34
+
35
+ Option Compare Database
36
+
37
+ Option Explicit
38
+
39
+ Const Inku = " IN '' [Ms Access;PWD=1234;DATABASE=C:\DBProtectBackEnd.ACCDB;]" '外部データベース接続文字列
40
+
41
+
42
+
43
+ Public Function MyDCount(Expr As String, Domain As String, Optional Criteria As String)
44
+
45
+ Dim strSQL As String
46
+
47
+ strSQL = "SELECT Count(" & Expr & ") FROM " & Domain & Inku
48
+
49
+ If Criteria <> "" Then
50
+
51
+ strSQL = strSQL & " WHERE " & Criteria
52
+
53
+ End If
54
+
55
+
56
+
57
+ Dim rs As DAO.Recordset
58
+
59
+ Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenForwardOnly, dbReadOnly)
60
+
61
+
62
+
63
+ MyDCount = rs(0)
64
+
65
+ End Function
66
+
67
+
68
+
69
+ Public Function MyDLookup(Expr As String, Domain As String, Optional Criteria As String)
70
+
71
+ Dim strSQL As String
72
+
73
+ strSQL = "SELECT " & Expr & " FROM " & Domain ' & Inku
74
+
75
+ If Criteria <> "" Then
76
+
77
+ strSQL = strSQL & " WHERE " & Criteria
78
+
79
+ End If
80
+
81
+
82
+
83
+ Dim rs As DAO.Recordset
84
+
85
+ Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenForwardOnly, dbReadOnly)
86
+
87
+
88
+
89
+ MyDLookup = rs(0)
90
+
91
+ End Function
92
+
93
+ ```