ファイルオープンダイアログで前回開いたフォルダを開く。


去年作の業務アプリで今日、
「開く度にマイドキュメントに戻されるのを何とか出来ない?」と言われたので作ってみた。


前回開いたフォルダ情報は無難にワークシート(非表示)内に保存。
レジストリ作ったり外部ファイルで設定持ったりすると配るとき不便なので。


共有フォルダを開くところは少しだけ苦戦。
ChDir でネットワークディレクトリにアクセス出来ないとは知らなかった。


ファイルオープンダイアログで前回開いたフォルダを開く

'コンフィグシートに保存されてる前回開いたフォルダがあるなら、今回も存在するか確認する。
    If ThisWorkbook.Worksheets(2).Range("B1") <> "" Then
        
        'ローカルフォルダの場合
        If InStr(ThisWorkbook.Worksheets(2).Range("B1"), "\\") = 0 Then
            'フォルダが存在するなら、前回開いたフォルダを今回も開く。
            If Dir(ThisWorkbook.Worksheets(2).Range("B1"), vbDirectory) <> "" Then
                ChDrive (UCase(Left(ThisWorkbook.Worksheets(2).Range("B1"), 1)))
                ChDir (ThisWorkbook.Worksheets(2).Range("B1"))
            End If
        
        '共有フォルダの場合
        Else
            'フォルダが存在するなら、前回開いたフォルダを今回も開く。
            Dim fso As Object
            Dim sh As Object
            Set fso = CreateObject("Scripting.FileSystemObject")
            Set sh = CreateObject("WScript.Shell")
            If fso.FolderExists(ThisWorkbook.Worksheets(2).Range("B1")) Then
                    sh.CurrentDirectory = ThisWorkbook.Worksheets(2).Range("B1")
            End If
            Set fso = Nothing
            Set sh = Nothing
            
        End If
        
    End If
    
    'ファイルオープンダイアログを、複数選択を有効にして開く
    sourceFiles = Application.GetOpenFilename( _
        FileFilter:="全てのファイル (*.*),*.*" & _
        ",Microsoft Office Excel ファイル (*.xls),*.xls" & _
        ",CSV (カンマ区切り) (*.csv),*.csv", _
        FilterIndex:=2, _
        MultiSelect:=True)
    
    '今回開いたフォルダでファイルを開いたらフォルダ情報を保存し、キャンセルならフォルダ情報は保存しない。
    If IsArray(sourceFiles) Then
        ThisWorkbook.Worksheets(2).Range("B1") = Left(sourceFiles(1), InStrRev(sourceFiles(1), "\") - 1)
        ThisWorkbook.Save
    End If