teratail
回答率
85.47%
質問するログイン新規登録
トップVBAに関する質問任意(指定)のフォルダを開きたい　ネットワークドライブ？

編集履歴

回答編集履歴

1

<code>を使った方法へ記述を入れ替え

2020/05/19 00:53

投稿

tosi
tosi

スコア553

test CHANGED
@@ -8,19 +8,15 @@
8
8
 
9
9
  私にはこれしかやり方が分かりません。
10
10
 
11
- '-----------------------------------------------
12
-
13
- (ソースコード)
11
+ ```ここに言語を入力
14
-
15
-
16
12
 
17
13
  Option Explicit
18
14
 
19
- '***********************************************
15
+ '*******************************************
20
16
 
21
17
  ' Private Work Area
22
18
 
23
- '***********************************************
19
+ '*******************************************
24
20
 
25
21
  Private strFilter As String
26
22
 
@@ -28,63 +24,57 @@
28
24
 
29
25
  Private strDefFolderName As String
30
26
 
31
- '***********************************************
27
+ '*******************************************
32
28
 
33
29
  ' API Area
34
30
 
35
- '***********************************************
31
+ '*******************************************
36
-
37
- 'Get Open File
32
+
38
-
39
- Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
33
+ Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long
40
-
41
- (lpofn As OPENFILENAME) As Long
42
34
 
43
35
  Private Type OPENFILENAME
44
36
 
45
- lStructSize As Long '構造体のサイズ
37
+ lStructSize As Long '構造体のサイズ
46
-
38
+
47
- hwndOwner As Long 'ダイアログボックスの親ウィンドウハンドル
39
+ hwndOwner As Long 'ダイアログボックスの親ウィンドウハンドル
48
-
40
+
49
- hInstance As Long 'テンプレートリソースを持つモジュールのインスタンスハンドル(不用のとき0)
41
+ hInstance As Long 'テンプレートリソースを持つモジュールのインスタンスハンドル(不用のとき0)
50
-
42
+
51
- lpstrFilter As String 'フィルタ(Visual Basicのファイルパターンのこと)
43
+ lpstrFilter As String 'フィルタ(Visual Basicのファイルパターンのこと)
52
-
44
+
53
- lpstrCustomFilter As String 'カスタムフィルタ
45
+ lpstrCustomFilter As String 'カスタムフィルタ
54
-
46
+
55
- nMaxCustomFilter As Long '同、バイト数
47
+ nMaxCustomFilter As Long '同、バイト数
56
-
48
+
57
- nFilterIndex As Long 'ダイアログに優先的に表示するフィルタのインデックス
49
+ nFilterIndex As Long 'ダイアログに優先的に表示するフィルタのインデックス
58
-
50
+
59
- lpstrFile As String '(戻り値)フルパス名を受け取るバッファ
51
+ lpstrFile As String '(戻り値)フルパス名を受け取るバッファ
60
-
52
+
61
- nMaxFile As Long '同、バイト数
53
+ nMaxFile As Long '同、バイト数
62
-
54
+
63
- lpstrFileTitle As String '(戻り値)ファイル名を受け取るバッファ
55
+ lpstrFileTitle As String '(戻り値)ファイル名を受け取るバッファ
64
-
56
+
65
- nMaxFileTitle As Long '同、バイト数
57
+ nMaxFileTitle As Long '同、バイト数
66
-
58
+
67
- lpstrInitialDir As String '初期のディレクトリ名
59
+ lpstrInitialDir As String '初期のディレクトリ名
68
-
60
+
69
- lpstrTitle As String 'ダイアログのキャプション
61
+ lpstrTitle As String 'ダイアログのキャプション
70
-
62
+
71
- flags As Long '動作を指定
63
+ flags As Long '動作を指定
72
-
64
+
73
- nFileOffset As Integer 'フルパス中のファイル名までのオフセット
65
+ nFileOffset As Integer 'フルパス中のファイル名までのオフセット
74
-
66
+
75
- nFileExtension As Integer '同、拡張子までのオフセット
67
+ nFileExtension As Integer '同、拡張子までのオフセット
76
-
68
+
77
- lpstrdefext As String 'デフォルトの拡張子
69
+ lpstrdefext As String 'デフォルトの拡張子
78
-
70
+
79
- lCustData As Long 'フックプロシージャに渡すデータ
71
+ lCustData As Long 'フックプロシージャに渡すデータ
80
-
72
+
81
- lpfnHook As Long 'フックプロシージャへのポインタ
73
+ lpfnHook As Long 'フックプロシージャへのポインタ
82
-
74
+
83
- lpTemplateName As String 'テンプレートリソース名
75
+ lpTemplateName As String 'テンプレートリソース名
84
-
76
+
85
- End Type
77
+ End Type
86
-
87
-
88
78
 
89
79
  'uFlagsの定数
90
80
 
@@ -132,176 +122,150 @@
132
122
 
133
123
  Private Const OFN_NONETWORKBUTTON = &H20000 'ネットワークボタンを非表示・無効にする
134
124
 
135
- Private Const OFN_SHAREAWARE = &H4000 'ファイルを開いたときにネットワーク共有違反のためエラーが発生してもエラーを無視する
125
+ Private Const OFN_SHAREAWARE = &H4000 'ファイルを開いたときにネットワーク共有違反のためエラーが発生してもエラーを無視する
136
-
137
-
138
126
 
139
127
  Private lpofn As OPENFILENAME
140
128
 
141
- '
142
-
143
-
144
-
145
- '******************************************************************
146
-
147
-
148
-
149
- ' @(f)
150
-
151
-
152
-
153
- ' Function : OpenFileDialog
154
-
155
-
156
-
157
- ' Return : True:Nomal False:Abnomal
158
-
159
-
160
-
161
- ' Argument :
162
-
163
-
164
-
165
- ' Description :
166
-
167
-
168
-
169
- ' Note :
170
-
171
-
172
-
173
- '******************************************************************
174
-
175
- Private Function OpenFileDialog() As Boolean
176
-
177
-
178
-
179
- Dim fs As Object
180
-
181
- Dim MyFolder As Object
182
-
183
- Dim MyPath As String
184
-
185
- Dim strFileName As String
186
-
187
- Dim blnErr As Boolean
188
-
189
-
190
-
191
- Dim lpofn As OPENFILENAME
192
-
193
- Dim rc As Variant
194
-
195
- Dim a As Long
196
-
197
-
198
-
199
- Set fs = CreateObject("Scripting.FileSystemObject")
200
-
201
- If fs.FolderExists(strDefFolderName) = False Then
202
-
203
- MsgBox "Error Exist:" & strDefFolderName
204
-
205
- Exit Function
206
-
207
- Else
208
-
209
- MyPath = strDefFolderName
210
-
211
- End If
212
-
213
-
214
-
215
- With lpofn
216
-
217
- '
218
-
219
- .flags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
220
-
221
- .lStructSize = Len(lpofn)
222
-
223
- '.hwndOwner = Application.hWndAccessApp
224
-
225
- .lpstrFileTitle = String(512, Chr(0))
226
-
227
- .nMaxFileTitle = 512
228
-
229
- .lpstrFile = String(512, Chr(0))
230
-
231
- .nMaxFile = 512
232
-
233
- .lpstrTitle = "Select Variable Definition File"
234
-
235
-
236
-
237
- .lpstrFilter = strFilter
238
-
239
- .lpstrInitialDir = MyPath
240
-
241
- .nFilterIndex = 1
242
-
243
- .lpstrFile = String(512, Chr(0))
244
-
245
- '
246
-
247
- rc = GetOpenFileName(lpofn)
248
-
249
- If rc > 0 Then
250
-
251
- a = InStr(.lpstrFile, Chr(0))
252
-
253
- strFileName = Mid(.lpstrFile, 1, a - 1)
254
-
255
- blnErr = False
256
-
257
- Else
258
-
259
- 'No Select
260
-
261
- Set fs = Nothing
262
-
263
- Exit Function
264
-
265
- End If
266
-
267
- '
268
-
269
- End With
270
-
271
-
272
-
273
- Set fs = Nothing
129
+ '
130
+
131
+ '**************************************************************
132
+
133
+ ' @(f)
134
+
135
+ ' Function : OpenFileDialog
136
+
137
+ ' Return : True:Nomal False:Abnomal
138
+
139
+ ' Argument :
140
+
141
+ ' Description :
142
+
143
+ ' Note :
144
+
145
+ '**************************************************************
146
+
147
+ Private Function OpenFileDialog() As Boolean
148
+
149
+ Dim fs As Object
150
+
151
+ Dim MyFolder As Object
152
+
153
+ Dim MyPath As String
154
+
155
+ Dim strFileName As String
156
+
157
+ Dim blnErr As Boolean
158
+
159
+ Dim lpofn As OPENFILENAME
160
+
161
+ Dim rc As Variant
162
+
163
+ Dim a As Long
164
+
165
+ Set fs = CreateObject("Scripting.FileSystemObject")
166
+
167
+ If fs.FolderExists(strDefFolderName) = False Then
168
+
169
+ MsgBox "Error Exist:" & strDefFolderName
170
+
171
+ Exit Function
172
+
173
+ Else
174
+
175
+ MyPath = strDefFolderName
176
+
177
+ End If
178
+
179
+ With lpofn
180
+
181
+ '
182
+
183
+ .flags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
184
+
185
+ .lStructSize = Len(lpofn)
186
+
187
+ '.hwndOwner = Application.hWndAccessApp
188
+
189
+ .lpstrFileTitle = String(512, Chr(0))
190
+
191
+ .nMaxFileTitle = 512
192
+
193
+ .lpstrFile = String(512, Chr(0))
194
+
195
+ .nMaxFile = 512
196
+
197
+ .lpstrTitle = "Select Variable Definition File"
198
+
199
+ .lpstrFilter = strFilter
200
+
201
+ .lpstrInitialDir = MyPath
202
+
203
+ .nFilterIndex = 1
204
+
205
+ .lpstrFile = String(512, Chr(0))
206
+
207
+ '
208
+
209
+ rc = GetOpenFileName(lpofn)
210
+
211
+ If rc > 0 Then
212
+
213
+ a = InStr(.lpstrFile, Chr(0))
214
+
215
+ strFileName = Mid(.lpstrFile, 1, a - 1)
216
+
217
+ blnErr = False
218
+
219
+ Else
220
+
221
+ 'No Select
222
+
223
+ Set fs = Nothing
224
+
225
+ Exit Function
226
+
227
+ End If
228
+
229
+ '
230
+
231
+ End With
232
+
233
+ Set fs = Nothing
234
+
235
+
236
+
237
+ End Function
238
+
239
+
240
+
241
+ Public Function runOpenFileDialog_Excel() As Boolean
242
+
243
+
244
+
245
+ '-------------------------------------------
246
+
247
+ 'ネットワークフォルダ名を指定
248
+
249
+ strDefFolderName = "\192.168.3.4\test"
250
+
251
+ '-------------------------------------------
252
+
253
+ strFilter = ""
254
+
255
+ strFilter = strFilter & "Excel File(*.xls)" + Chr(0) + "*.xls" + Chr(0) + ""
256
+
257
+ strFilter = strFilter & "Excel File(*.xlsx)" + Chr(0) + "*.xlsx" + Chr(0) + ""
258
+
259
+ strFilter = strFilter & "All File(*.*)" + Chr(0) + "*.*"
260
+
261
+ If OpenFileDialog() = False Then
262
+
263
+ Exit Function
264
+
265
+ End If
274
266
 
275
267
 
276
268
 
277
269
  End Function
278
270
 
279
-
280
-
281
- Public Function runOpenFileDialog_Excel() As Boolean
282
-
283
- '-------------------------------------------
284
-
285
- 'ネットワークフォルダ名を指定
286
-
287
- strDefFolderName = "\172.16.5.100\test\test"
288
-
289
- '-------------------------------------------
290
-
291
- strFilter = ""
292
-
293
- strFilter = strFilter & "Excel File(*.xls)" + Chr(0) + "*.xls" + Chr(0) + ""
294
-
295
- strFilter = strFilter & "Excel File(*.xlsx)" + Chr(0) + "*.xlsx" + Chr(0) + ""
296
-
297
- strFilter = strFilter & "All File(*.*)" + Chr(0) + "*.*"
298
-
299
- If OpenFileDialog() = False Then
300
-
301
- Exit Function
302
-
303
- End If
271
+ ```
304
-
305
- End Function
306
-
307
- '-----------------------------------------------