任意(指定)のフォルダを開きたい　ネットワークドライブ？

いろいろネットで調べてたが上手くいかない為ご教授下さい。
調べた結果GetOpenFilenameを使用してフォルダ開くのは分かったのですが
アドレス（ドライブ？ネットワークドライブ？）がわからず開けません。

フォルダは社内の共有サーバー
(社内のどのパソコンでもアクセス可能なフォルダ)に保管されています。

試した事

①開きたいフォルダのパスをコピーしてChDirに挿入しても上手くいきませんでした。
②下記コードで出力されたパスを挿入しても上手くいきませんでした。

VBA
1Dim a As String
2a = ThisWorkbook.Path
3Debug.Print a
4

###現在の実行結果
デフォルト設定？されているファイルは開きます。

###問題のコード

VBA
1Dim OpenFile As String
2    ChDrive "C"　’←この中にドライブ？を入れる？
3    ChDir ""　’←この中にアドレスを入れる？
4    OpenFile = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")

まず、開きたいフォルダパスを調べないといけないのでしょうが、どれが正解かわかりません。
いろいろと分からない事だらけです。
ご不明な点がございましたらコメント下さい。
よろしくお願いします。

###追記
アドレスはフォルダの上の部分(添付ファイルの画像)をコピペすれば良いのでしょうか？

m.ts10806

2020/05/15 21:58

「アドレスが分からない」のであれば普段どのように共有サーバーにアクセスしているのでしょうか

abiek

2020/05/17 08:22

回答ありがとうござます。もともとショートカットがあるのでそこからアクセスしております。

glam0337_k

2020/05/23 23:14

横から失礼します。ショートカットファイルがあるならショートカットを右クリックして「プロパティ」でリンク先のアドレスが見られると思います。それと、開く目的のファイルを開いて（あるいは他のファイルでもいいですが） VBEでイミディエイトウィンドウを開いて「?Thisworkbook.path」でも調べられませんかね。ファイルパス、フォルダパス（アドレス）そのものに関してはパソコンについての基本的な事項ですが、その部分はご存知ですか。

行動規範の内容に同意します

回答3件

再回答。

Sub Test_Sample_Miniature()
    Set ws = CreateObject("WScript.Shell")
　　'適当なネットワークフォルダへ変更。
    ws.CurrentDirectory = "\192.168.3.4\test\" 
    xx = Application.GetOpenFileName
    Set ws = Nothing
End Sub

又は、(VBA7でAPI使う場合）

Option Explicit
'*******************************************
' Private Work Area
'*******************************************
Private strFilter As String
Private strTitle As String
Private strDefFolderName As String
'*******************************************
' API Area
'*******************************************
'Get Open File
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As LongPtr
        lpfnHook As LongPtr
        lpTemplateName As String
End Type
'uFlags
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLESIZING = 0
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_EXPLORER = &H80000
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_SHAREAWARE = &H4000
Private lpofn As OPENFILENAME
'
'**************************************************************
' @(f)
' Function    : OpenFileDialog
' Return      : True:Nomal False:Abnomal
' Argument    :
' Description :
' Note        :
'**************************************************************
Private Function OpenFileDialog() As Boolean
    Dim fs As Object
    Dim MyFolder As Object
    Dim MyPath As String
    Dim strFileName As String
    Dim blnErr As Boolean
    Dim lpofn As OPENFILENAME
    Dim rc As Variant
    Dim a As Long
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FolderExists(strDefFolderName) = False Then
        MsgBox "Error Exist:" & strDefFolderName
        Exit Function
    Else
        MyPath = strDefFolderName
    End If
    
    With lpofn
        '
        .flags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
        .lStructSize = LenB(lpofn)
        '.hwndOwner = Application.hWndAccessApp
        .lpstrFileTitle = String(512, Chr(0))
        .nMaxFileTitle = 512
        .lpstrFile = String(512, Chr(0))
        .lpstrFile = ""
        .nMaxFile = 512
        .lpstrTitle = "Select Variable Definition File"
        .lpstrFilter = strFilter
        .lpstrInitialDir = MyPath
        .nFilterIndex = 1
        .lpstrFile = String(512, Chr(0))
        '
        rc = GetOpenFileName(lpofn)
        If rc > 0 Then
            a = InStr(.lpstrFile, Chr(0))
            strFileName = Mid(.lpstrFile, 1, a - 1)
            blnErr = False
        Else
            'No Select
            Set fs = Nothing
            Exit Function
        End If
        '
    End With
    Set fs = Nothing

End Function

Public Function Test_Sample_Miniature() As Boolean
    '-------------------------------------------
    '適当なネットワークフォルダへ変更。
    strDefFolderName = "\192.168.3.4\test"
    '-------------------------------------------
    strFilter = ""
    strFilter = strFilter & "Excel File(*.xls)" + Chr(0) + "*.xls" + Chr(0) + ""
    strFilter = strFilter & "Excel File(*.xlsx)" + Chr(0) + "*.xlsx" + Chr(0) + ""
    strFilter = strFilter & "All File(*.*)" + Chr(0) + "*.*"
    If OpenFileDialog() = False Then
        Exit Function
    End If
End Function

投稿2020/05/19 00:43

編集2020/05/21 23:58

tosi

総合スコア553

dodox86

2020/05/19 00:46

元のご回答への編集、追記で良かったのでは。

tosi

2020/05/19 01:40

最初は追記したんですけど<code>が無くて綺麗になりませんでした。何か良い方法あったんでしょうか。

dodox86

2020/05/19 01:52

> 最初は追記したんですけど<code>が無くて綺麗になりませんでした。いやそんなはずは無いかと。回答の「編集」で出てくる「本文」の入力欄の上部分に、"<code>"(コードの挿入)ボタンがあるはずです。 https://teratail.com/help/question-tips#questionTips3-5-1 もしそれが使えなくても、マークダウン記法でバッククォーテーション3つ(```) で直接、ソースコード部分をくくれば使えます。 ```VBA Sub Hoge() End Sub ```

tosi

2020/05/19 02:09

>いやそんなはずは無いかと。回答の「編集」で出てくる「本文」の入 >力欄の>上部分に、"<code>"(コードの挿入)ボタンがあるはずです。あれ？追記とはコメント欄の事ではないですか。回答の欄には<code>見えますけど、追記(コメント)の回答に含めるべき内容は回答に追記しましょう。[コメント] の上の入力欄にはないですね。 ```も打って見ましたが変か無く断念してます。

dodox86

2020/05/19 02:16

> あれ？追記とはコメント欄の事ではないですか。いえ、ここで言ってる「追記」とは、回答欄への編集を含めた追記のことでした。混乱させてしまったようで申し訳ありません。コメント欄ではそのとおりで、マークダウン記法は使えません。

tosi

2020/05/19 08:12

了解致しました。

行動規範の内容に同意します

動かなかったら申し訳けありません。
下記コードを丸ごとExcel標準モジュールへ複写し、
最下部のstrDefFolderNameへ存在するネットワークフォルダ名へ入れ替えて
runOpenFileDialog_Excelを動かして見て下さい。
私にはこれしかやり方が分かりません。

Option Explicit
'*******************************************
' Private Work Area
'*******************************************
Private strFilter As String
Private strTitle As String
Private strDefFolderName As String
'*******************************************
' API Area
'*******************************************
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long
Private Type OPENFILENAME
	lStructSize As Long                         '構造体のサイズ
	hwndOwner As Long                           'ダイアログボックスの親ウィンドウハンドル
	hInstance As Long                           'テンプレートリソースを持つモジュールのインスタンスハンドル(不用のとき0)
	lpstrFilter As String                       'フィルタ(Visual Basicのファイルパターンのこと)
	lpstrCustomFilter As String                 'カスタムフィルタ
	nMaxCustomFilter As Long                    '同、バイト数
	nFilterIndex As Long                        'ダイアログに優先的に表示するフィルタのインデックス
	lpstrFile As String                        '(戻り値)フルパス名を受け取るバッファ
	nMaxFile As Long                            '同、バイト数
	lpstrFileTitle As String                   '(戻り値)ファイル名を受け取るバッファ
	nMaxFileTitle As Long                       '同、バイト数
	lpstrInitialDir As String                   '初期のディレクトリ名
	lpstrTitle As String                        'ダイアログのキャプション
	flags As Long                               '動作を指定
	nFileOffset As Integer                      'フルパス中のファイル名までのオフセット
	nFileExtension As Integer                   '同、拡張子までのオフセット
	lpstrdefext As String                       'デフォルトの拡張子
	lCustData As Long                           'フックプロシージャに渡すデータ
	lpfnHook As Long                            'フックプロシージャへのポインタ
	lpTemplateName As String                    'テンプレートリソース名
End Type 
'uFlagsの定数
Private Const OFN_ALLOWMULTISELECT = &H200      '複数ファイルを選択可能にする
Private Const OFN_CREATEPROMPT = &H2000         '指定のファイル名がないとき、ファイルを作成するかどうかを問い合わせるダイアログを表示する
Private Const OFN_HIDEREADONLY = &H4            '上書き禁止チェックボックスを表示しない
Private Const OFN_NODEREFERENCELINKS = &H100000 'ショートカットリンク（.lnk）ファイル名をそのまま返す（このフラッグを指定しないとき、リンク先のフルパスが戻る）
Private Const OFN_NOREADONLYRETURN = &H8000     '読み取り専用属性のファイルと書込み禁止ディレクトリを選択したとき、メッセージボックスを表示する
Private Const OFN_READONLY = &H1                '上書き禁止チェックボックスをチェックする
Private Const OFN_OVERWRITEPROMPT = &H2         '既存ファイル名を指定したとき、メッセージボックスを表示する
Private Const OFN_EXTENSIONDIFFERENT = &H400    'lpstrDefExt と異なる拡張子の入力を許可する（このフラッグは lpstrDefExt が vbNullString のとき無効）
Private Const OFN_FILEMUSTEXIST = &H1000        '指定のファイル名が存在しないとき、メッセージボックスを表示する
Private Const OFN_NOTESTFILECREATE = &H10000    'ダイアログ終了前に、書き込み禁止属性などのチェックのためのテスト用ファイルを作成しない
Private Const OFN_NOVALIDATE = &H100            'ファイル名の有効性をチェックしない（ただし、ファイル名が不正な場合、メッセージは表示される）
Private Const OFN_PATHMUSTEXIST = &H800         '有効なパス名だけを受付ける（不正なファイル名が入力されたとき、メッセージを表示する。ただし、これがデフォルトの設定であるので、このフラッグを指定する必要はない）
Private Const OFN_SHOWHELP = &H10               'ヘルプボタンを表示する
Private Const OFN_ENABLEHOOK = &H20             'lpfnHook メンバを有効にする
Private Const OFN_ENABLESIZING = 0              '
Private Const OFN_ENABLETEMPLATE = &H40         'テンプレートを使う
Private Const OFN_ENABLETEMPLATEHANDLE = &H80   'hInstance はテンプレートへのポインタを指す
Private Const OFN_EXPLORER = &H80000            'エクスプローラ型ダイアログとして表示
Private Const OFN_LONGNAMES = &H200000          '旧スタイルのダイアログのとき、ロングファイル名を使用可能にする（エクスプローラ型のときは常にロングファイル名が使える）
Private Const OFN_NOCHANGEDIR = &H8             'ダイアログ終了後、元のディレクトリに戻る
Private Const OFN_NOLONGNAMES = &H40000         '旧スタイルのダイアログのとき、ショートファイル名を使用可能にする（エクスプローラ型のときは常にロングファイル名が使える）
Private Const OFN_NONETWORKBUTTON = &H20000     'ネットワークボタンを非表示・無効にする
Private Const OFN_SHAREAWARE = &H4000           'ファイルを開いたときにネットワーク共有違反のためエラーが発生してもエラーを無視する 
Private lpofn As OPENFILENAME
' 
'************************************************************** 
' @(f) 
' Function    : OpenFileDialog 
' Return      : True:Nomal False:Abnomal 
' Argument    : 
' Description : 
' Note        : 
'**************************************************************
Private Function OpenFileDialog() As Boolean 
	Dim fs As Object
	Dim MyFolder As Object
	Dim MyPath As String
	Dim strFileName As String
	Dim blnErr As Boolean 
	Dim lpofn As OPENFILENAME
	Dim rc As Variant
	Dim a As Long 
	Set fs = CreateObject("Scripting.FileSystemObject")
	If fs.FolderExists(strDefFolderName) = False Then
		MsgBox "Error Exist:" & strDefFolderName
		Exit Function
	Else
		MyPath = strDefFolderName
	End If 
	With lpofn
		'
		.flags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
		.lStructSize = Len(lpofn)
		'.hwndOwner = Application.hWndAccessApp
		.lpstrFileTitle = String(512, Chr(0))
		.nMaxFileTitle = 512
		.lpstrFile = String(512, Chr(0))
		.nMaxFile = 512
		.lpstrTitle = "Select Variable Definition File" 
		.lpstrFilter = strFilter
		.lpstrInitialDir = MyPath
		.nFilterIndex = 1
		.lpstrFile = String(512, Chr(0))
		'
		rc = GetOpenFileName(lpofn)
		If rc > 0 Then
			a = InStr(.lpstrFile, Chr(0))
			strFileName = Mid(.lpstrFile, 1, a - 1)
			blnErr = False
		Else
			'No Select
			Set fs = Nothing
			Exit Function
		End If
		'
	End With 
	Set fs = Nothing 

End Function 

Public Function runOpenFileDialog_Excel() As Boolean

	'-------------------------------------------
	'ネットワークフォルダ名を指定
	strDefFolderName = "\192.168.3.4\test"
	'-------------------------------------------
	strFilter = ""
	strFilter = strFilter & "Excel File(*.xls)" + Chr(0) + "*.xls" + Chr(0) + ""
	strFilter = strFilter & "Excel File(*.xlsx)" + Chr(0) + "*.xlsx" + Chr(0) + ""
	strFilter = strFilter & "All File(*.*)" + Chr(0) + "*.*"
	If OpenFileDialog() = False Then
		Exit Function
	End If

End Function

投稿2020/05/16 04:44

編集2020/05/19 00:53

tosi

総合スコア553

abiek

2020/05/17 08:20

回答ありがとうござます。下記コードが構文エラーになってしまします。 Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _ (lpofn As OPENFILENAME) As Long お手数ですが、どこがおかしいのか教えていただけますでしょうか？よろしくお願いします

tosi

2020/05/17 18:05 編集

OSのAPI(DLLファイル定義)部のエラーです。 Excelのバーションと64ビット品か32ビット品か教えて下さい。出来れば、OSのバーション及び64品か32ビット品かもお願いします。デバックメニューのコンパイルを動かすとエラーになるかと思いますが、こちらが通らないとダメです。こちらはWindows10(64bit)/Excel2010(32bit)で動きました。 64bitならば書き直しが必要で、調べないと分からないです。因みに、下記コードでは動きませんか？ ------------------------------------------ Sub test() Set ws = CreateObject("WScript.Shell") ws.CurrentDirectory = "\192.168.3.4\test\" '<---適当に変更する xx = Application.GetOpenFileName Set ws = Nothing End Sub '------------------------------------------ (参考資料) http://officetanaka.net/excel/vba/file/file02.htm http://officetanaka.net/other/extra/tips15.htm

dodox86

2020/05/17 21:17

＞回答者tosiさん回答中のソースコードですが、マークダウン記法で記載していただけるとインデントも壊れず、他の閲覧者にとっても読み易くなって良いです。 https://teratail.com/help/question-tips#questionTips3-5-1 編集をご検討いただけますと幸いです。

tosi

2020/05/17 23:01

はい。次回試してみます。

tosi

2020/05/19 01:43 編集

過去のソースも入れ替えます。

行動規範の内容に同意します

ChDir で　開きたいファイルが存在するフォルダパスを指定してみてください。

[ファイルを開く]ダイアログボックスを表示する（GetOpenFilenameメソッド）｜Excel

投稿2020/05/15 23:06