ExcelVBA：GetOpenFileName のデフォルトフォルダをネットワークドライブ（Sharepointのアドレス）にしたい

前提

ExcelVBAで、マクロと同じ場所にあるファイルを開いて処理を行いたいです。
マクロはローカルドライブ上にあることもあれば、Sharepoint上にあることもあります。
Sharepointのアドレスをネットワークアドレスの形（https://sharepoint.～を\\sharepoint.～）に変換し、
APIのSetCurrentDirectoryを使って、カレントディレクトリにセットするまではできるのですが（CurDirで確認済み）、その状態でGetOpenFileName を実行すると、GetOpenFileName 上のデフォルトフォルダがローカルのドキュメントフォルダになってしまいます。

実現したいこと

GetOpenFileName 上のデフォルトフォルダをSharepointのアドレスにしたい

該当のソースコード

VBA

    Dim toolPath As String
    Dim toolDrive As String
    Dim FSO As Object
    Dim strFname As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    'ツールファイルのドライブ取得
    toolPath = ThisWorkbook.Path
    toolDrive = Left(toolPath, 1)
    If (Asc(toolDrive) >= 65 And Asc(toolDrive) <= 90) Then
        '大文字アルファベット
        'ツールファイルのフォルダ取得
        toolPath = Right(toolPath, Len(toolPath) - 2)
        toolPath = Left(toolPath, Len(toolPath) - InStrRev(toolPath, "\"))
    Else
        '大文字アルファベット以外
        toolDrive = ""
        toolPath = ConvertPath(toolPath, FSO)
    End If

    If Len(toolDrive) > 0 Then
        'カレントドライブ変更
        ChDrive toolDrive
        'カレントディレクトリ変更
        ChDir toolPath
    Else
        'カレントディレクトリ変更
        Call SetCurrentDirectory(toolPath)
    End If

    'インプットファイル選択
    strFname = Application.GetOpenFilename(Title:="見積総括表ファイル選択")
    
    If strFname <> "False" Then
        ActiveSheet.Range("$C$3").Value = strFname
    End If

Function ConvertPath(str As String, FSO As Object) As String
    On Error Resume Next
    If InStr(str, "/Documents") Then
        str = Right(str, Len(str) - InStr(str, "/Documents") - Len("/Documents") + 1)
        str = Replace(str, "/", "\")
        str = Environ("OneDrive") & str
    End If
    If InStr(str, "https:") Then
        If InStr(str, "?csf") Then
            str = Left(str, InStr(str, ".com/") + Len(".com/") - 2) _
                & Mid(str, InStr(str, "/site"), InStrRev(str, "?csf") - InStr(str, "/site"))
        Else
            str = Left(str, InStr(str, ".com/") + Len(".com/") - 2) _
                & Mid(str, InStr(str, "/site"), Len(str) - InStr(str, "/site") + 1)
        End If
        str = Replace(str, "https:", "")
        str = Replace(str, ".com", ".com@SSL\DavWWWRoot")
        str = Replace(str, "/", "\")
        With CreateObject("ScriptControl")
            .Language = "JScript"
            str = .CodeObject.decodeURI(str)
        End With
    End If
    If FSO.GetExtensionName(str) = "" And Right(str, 1) <> "\" And Right(str, 1) <> "/" Then
        str = str & "\"
    End If
    ConvertPath = str
End Function
------

pig_vba

2022/10/13 07:18

某所にて過去の同じような質問がヒットしました。直接的な解決にはならないですが、参考になるかもしれません。 https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q13227039668

pig_vba

2022/10/13 07:29

あとは、次善策ではありますがgetopenfilenameの代わりに Application.FileDialog(msoFileDialogFolderPicker).InitialFileName を使用してみるとかですかね。私の環境ではsharepoint使えないので検証できなくて申し訳ないですが https://www.web-dev-qa-db-ja.com/ja/excel/sharepoint%E3%82%B5%E3%82%A4%E3%83%88%E3%81%8B%E3%82%89excel%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%92%E9%96%8B%E3%81%8F/1041588613/

meg_

2022/10/13 11:15

> ExcelVBAで、マクロと同じ場所にあるファイルを開いて処理を行いたいです。 > マクロはローカルドライブ上にあることもあれば、Sharepoint上にあることもあります。 Sharepointにあるマクロを実行したいということですか？

pig_vba

2022/10/13 11:54

Thisworkbook.Pathをカレントに設定してるのでそういうことでしょう。質問者は「SharePoint上のマクロ動くには動くんやけど何でかカレントフォルダが強制的にローカルのデフォルト指すねん。どうすればええんや？」って聞いてるんだと思います

meg_

2022/10/13 11:57

pig_vbaさんへ SharePointではマクロは実行できないと思っていたのですができるんですね。SharePointとSharePointOnlineでは仕様が違うのかもしれませんね。

pig_vba

2022/10/13 15:07

ソースが一つしかないですが、これhttps://office54.net/iot/office365/sharepoint-excel-macro#section3 を見る限り実行はできるみたいです。利用してない私が憶測を垂れ流すのもアレなので質問者さんからの追記待ったほうが良さそうですね…

nao-y

2022/10/14 01:28 編集

ご回答いただきありがとうございます。返信が遅くなり申し訳ございません。 pig_vba様 ⓵Wsh.Scriptでは「'CurrentDirectory'メソッドは失敗しました：lWshShell3'オブジェクト」というエラーが出ました。このエラーはパスが有効でないときに出るようで、試しに対象のパスをエクスプローラーに入力したところ、「見つかりませんでした」と返ってきました。ここがミソのようです。このエラーメッセージで検索したページにヒントがありそうなので調べてみます。 ②Application.FileDialogは質問と同じ結果（ドキュメントフォルダがデフォルトになる）でした。 meg_様,pig_vba様 pig_vba様の(2022/10/14 00:07)示されたURLの通り、Sharepoint上のマクロは実行できます。正確には、・Sharepoint上のマクロファイルを開くときに「アプリケーションで開く」を選択する（pig_vba様がご紹介くださった方法）・Sharepoint上のマクロのあるフォルダを同期してエクスプローラーで開き、そこからマクロファイルを開くという方法を使うので、マクロが動くのはSharepoint上ではなく、ローカルPCかもしれませんが。しかし、上の方法でマクロを開いて、ABEのイミディエイトウィンドウで ?Thisworkbook.Path と入力すると https://xxxx.sharepoint.com/～と表示されるので、確かにSharepoint上のマクロを動かしていることになります。とにかく⓵を深彫りしてみます。ありがとうございました。

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

回答1件

自己解決

Application.FileDialogを使うことによって解決しました。

具体的には以下のコードで動作しました。

    Dim toolPath As String
    Dim fname As String

    'ツールファイルのドライブ取得
    toolPath = ThisWorkbook.Path

    'インプットファイル選択
    'ファイルダイアログの表示、選択
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "*.xlsm", "*.xlsm"
        .InitialFileName = toolPath
        .AllowMultiSelect = False
        .Title = "見積総括表の選択"
        If .Show = True Then
            fname = .SelectedItems(1)
            If InStr(fname, "https://") Then
                fname = Replace(fname, "https://", "\\")
                fname = Replace(fname, ".com", ".com@SSL\DavWWWRoot")
                fname = Replace(fname, "/", "\")
            End If
        Else
            MsgBox "キャンセルしました", vbInformation
        End If
    End With

Thisworkbook.pathで取得したパス"http://xxxx.smfg.com～"を加工する必要はありませんでした。
ただし、ツール内でファイルオープンするときはソースの"If InStr(fname, "https://") Then"以降の置換を行う必要があります。

ご協力くださった方々、ありがとうございました。

このＱＡが今後の役に立ちますように。

投稿2022/10/17 05:09

nao-y

総合スコア26