WScript创建的快捷方式未显示原文件扩展名问题求助

问题出在你构建快捷方式路径的代码行——你用Replace把原文件的扩展名直接替换成了.lnk，导致快捷方式文件名丢失了原扩展名。

修改方案 #

不需要依赖快捷方式的特殊属性，直接调整快捷方式路径的生成逻辑即可：

方案1：保留原文件扩展名（生成如「File1.xlsm.lnk」的快捷方式，显示为「File1.xlsm」）

替换原代码中创建快捷方式的那一行：

' 原代码（问题所在）
Set objShortcut = objShellWScript.CreateShortcut(Replace(varFilePath, "." & objFileSystemObject.GetExtensionName(varFilePath), ".lnk"))

' 修改后的代码
Set objShortcut = objShellWScript.CreateShortcut( _
    objFileSystemObject.BuildPath( _
        objFileSystemObject.GetParentFolderName(varFilePath), _
        objFileSystemObject.GetFileName(varFilePath) & ".lnk" _
    ) _
)

方案2：生成与手动创建一致的名称（如「File1.xlsm - 快捷方式.lnk」，显示为「File1.xlsm - 快捷方式」）

如果需要和手动创建的快捷方式命名完全对齐，可按以下方式修改：

' 先获取原文件的完整名称（含扩展名）
Dim originalFileName
originalFileName = objFileSystemObject.GetFileName(objFile.Path)

' 构建带「- 快捷方式」后缀的快捷路径
Set objShortcut = objShellWScript.CreateShortcut( _
    objFileSystemObject.BuildPath(varShortcutFolderPath, originalFileName & " - 快捷方式.lnk") _
)

完整修改后的代码片段 #

Set objShellWScript = CreateObject("WScript.Shell")

If objFolder.Files.Count > 0 Then
    
    For Each objFile In objFolder.Files
        
        With objFile
            
            varFilePath = Replace(.Path, varDestinationFolderPath, varShortcutFolderPath, 1, 1)
            
            ' 使用方案1的代码替换原创建快捷方式的行
            Set objShortcut = objShellWScript.CreateShortcut( _
                objFileSystemObject.BuildPath( _
                    objFileSystemObject.GetParentFolderName(varFilePath), _
                    objFileSystemObject.GetFileName(varFilePath) & ".lnk" _
                ) _
            )
            
            With objShortcut
                
                .Description = objFile.Path
                
                .TargetPath = objFile.Path
                
                .Save
                
            End With
            
            Set objShortcut = Nothing 
           
        End With    
    
    Next objFile  
  
End If

Set objShellWScript = Nothing

内容的提问来源于stack exchange，提问作者Andrew