Option Compare Database
Option Explicit

Type LnkFileInfo
    Arguments           As String '不明
    Description         As String 'exeファイル名
    FullName            As String 'ショートカットファイルのFull Pathファイル名
    IconLocation        As String 'アイコンファイル名,Location（1から開始） の順に表示。アイコンファイルがTargetPathの場合はアイコンファイル名はなし
    Hotkey              As String 'なしの時 !
    TargetPath          As String 'Full Pathでファイル名が返る
    WindowStyle         As String '1=通常のウィンドウ  3=最大化  7=最少化
    WorkingDirectory    As String '作業フォルダ
End Type
Public Lf As LnkFileInfo

Public Sub LsGetLnkFileInfo(ByVal strShortCutFile As String)
    'ショートカットファイル情報取得
    'Windows\system\wshom.ocxが必要です。(Windows Scripting Host)
    'wshom.ocxを参照設定して下さい。
    'wshom.ocxは Microsoft Internet Explorer 4.0 以上 をインストールするとインストールされます。
    '拡張子は.lnkまたは.urlであること
    '拡張子が.urlのばあいはFullNameとTargetPath（URL）が返る
    
    Dim WSH As Object       'Windows Scripting Hostオブジェクトを格納
    Dim scIcon As Object    'WSHShortCutオブジェクトを格納
    Dim clLf As LnkFileInfo, exp As String

    On Error Resume Next
    
    If strShortCutFile = "" Then Exit Sub
    exp = LCase(Right$(strShortCutFile, 4))
    If InStr(".lnk.url", exp) Then '拡張子は.lnkまたは.urlであること
    Else
        If exp <> ".lnk" Then strShortCutFile = strShortCutFile & ".lnk"
    End If
    
    Lf = clLf
    Set WSH = CreateObject("WScript.Shell")

    Set scIcon = WSH.CreateShortcut(strShortCutFile)

    With scIcon
        Lf.Arguments = "" & .Arguments
        Lf.Description = "" & .Description
        Lf.FullName = "" & .FullName
        Lf.IconLocation = "" & .IconLocation
        Lf.Hotkey = "" & .Hotkey
        Lf.TargetPath = "" & .TargetPath
        Lf.WindowStyle = "" & .WindowStyle
        Lf.WorkingDirectory = "" & .WorkingDirectory
    End With
End Sub