[[20231020160257]]　『選択ダイアログで選択させた「.lnk」「.url」フメx（たけとら）　ページの最後に飛ぶ

『選択ダイアログで選択させた「.lnk」「.url」ファイルのフルパス』（たけとら）

現在、VBAでApplication.FileDialogやApplication.GetOpenFilenameを用いて
ユーザに選択させたファイルのフルパスを取得し、

 1.ファイルの場合、ショートカットの作成
 2.ショートカットだった場合、ショートカットのコピー

をしたいと考えているのですが、

「.lnk」や「.url」のショートカットファイルが選択された場合、
戻り値がフルパスではなくリンク先となってしまい、
ファイルとしてコピーが出来ません。

また、取得されたリンク先から再度ショートカットを作成しようと思っても、
リンク先にスペースが含まれていると、
スペースより前までしか取得できておらず、
同じショートカットが作れません。

そこで質問なのですが、

 1.ユーザに選択させたショートカットファイルのフルパスを取得する方法
 2.ユーザに選択させたショートカットファイルのリンク先をスペース込みで取得する方法

があれば御教示願えますでしょうか。よろしくお願いいたします。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

 なんで現状のコードを書かないんですか？
 ちょと修正すればいいだけかもしれないのに
 回答者にゼロから書かせるって、どんないじめですか？
（´・ω・`） 2023/10/20(金) 18:54:24

  ざっくり↓こんな感じで出来るみたいです。(ホントかなぁ～?)

    Option Explicit
    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
        pvReserved As LongPtr
        dwReserved As Long
        FlagsEx As Long
    End Type

    Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
    'Private Const OFN_READONLY = &H1
    'Private Const OFN_OVERWRITEPROMPT = &H2
    'Private Const OFN_HIDEREADONLY = &H4
    'Private Const OFN_NOCHANGEDIR = &H8
    'Private Const OFN_SHOWHELP = &H10
    'Private Const OFN_ENABLEHOOK = &H20
    'Private Const OFN_ENABLETEMPLATE = &H40
    'Private Const OFN_ENABLETEMPLATEHANDLE = &H80
    'Private Const OFN_NOVALIDATE = &H100
    'Private Const OFN_ALLOWMULTISELECT = &H200
    'Private Const OFN_EXTENSIONDIFFERENT = &H400
    'Private Const OFN_PATHMUSTEXIST = &H800
    'Private Const OFN_FILEMUSTEXIST = &H1000
    'Private Const OFN_CREATEPROMPT = &H2000
    'Private Const OFN_SHAREAWARE = &H4000
    'Private Const OFN_NOREADONLYRETURN = &H8000&
    'Private Const OFN_NOTESTFILECREATE = &H10000
    'Private Const OFN_NONETWORKBUTTON = &H20000
    'Private Const OFN_NOLONGNAMES = &H40000
    'Private Const OFN_EXPLORER = &H80000
    Private Const OFN_NODEREFERENCELINKS = &H100000
    'Private Const OFN_LONGNAMES = &H200000
    'Private Const OFN_SHAREFALLTHROUGH = 2
    'Private Const OFN_SHARENOWARN = 1
    'Private Const OFN_SHAREWARN = 0

    Sub Test()
        Dim o As OPENFILENAME
        With o
            .lStructSize = Len(o)
            .hwndOwner = Application.Hwnd
            .lpstrFile = String$(&H200&, Chr(0))
            .nMaxFile = &H200&
            .lpstrFileTitle = String$(&H200&, Chr(0))
            .nMaxFileTitle = &H200&
            .lpstrTitle = "ファイルを開く"
            .flags = OFN_NODEREFERENCELINKS
        End With
        If GetOpenFileName(o) Then
            Dim fn As String
            fn = Left$(o.lpstrFile, InStr(o.lpstrFile, vbNullChar) - 1)
            Debug.Print fn
            If fn Like "*.lnk" Then Debug.Print GetLnkTargetPath(fn)
        End If
    End Sub
    Private Function GetLnkTargetPath(LnkFile As String) As String
        Dim aLnk As Object 'IWshRuntimeLibrary.WshShortcut
        With CreateObject("WScript.Shell")
            Set aLnk = .CreateShortcut(LnkFile)
            GetLnkTargetPath = aLnk.TargetPath
        End With
    End Function

（白茶） 2023/10/20(金) 22:07:08

白茶様

御回答ありがとうございます。

ほえー。APIの構造体を再定義して扱えるようにって感じなんですね！
構造体とか学生時代に習って以来使ったことなかったので、
こういうところでって目から鱗でした。勉強になりました！

（´・ω・`）様

1行目が全てだったので、
コードが必要と言われるとは思っていませんでした。

1.FileDialog の場合
With Application.FileDialog(msoFileDialogFilePicker)
　If .Show = True Then fPath = .SelectedItems(1)

2.GetOpenFilename の場合
FileName = Application.GetOpenFilename()

ショートカットファイル選択時、
fPathやFileNameがショートカットファイルのフルパスを取得しない。

（たけとら） 2023/10/23(月) 09:51:51

コメント返信：

[ 一覧(最新更新順) ]

[[20231020160257]] 『選択ダイアログで選択させた「.lnk」「.url」 フメx（たけとら） ページの最後に飛ぶ

[[20231020160257]]　『選択ダイアログで選択させた「.lnk」「.url」フメx（たけとら）　ページの最後に飛ぶ