Question

我正在尝试在目录中搜索快捷方式，获取快捷方式的路径，并将这些路径添加到集合中，以供日后使用。但是后续调用Dir（）会一遍又一遍地返回相同的文件。我已经通过调用下面定义的函数Getlnkpath将问题隔离开来。我自己没有写过这个函数，所以我不确定究竟是什么导致了这种行为，或者如何修复它。

tempPath = Dir(startPath & "*.lnk")
Do Until tempPath = vbNullString
    myCollection.Add Getlnkpath(startPath & tempPath) & "\"
    tempPath = Dir()
Loop

Function Getlnkpath(ByVal Lnk As String)
   On Error Resume Next
   With CreateObject("Wscript.Shell").CreateShortcut(Lnk)
       Getlnkpath = .TargetPath
       .Close
   End With
End Function

Answer 1

可能更安全

首先：收集所有链接路径
然后：收集所有链接目标路径

这样第一个集合可以保持稳定，无论后续操作可能做什么（除非他们删除某些链接或某个文件夹......）

此外我建议只初始化一个Wscript.Shell对象，并用它来处理对CreateShortcut()的所有调用，而不是为每个链接实例化一个对象

最后，由于我有时遇到后者的问题，我自己正在逐渐使用FileSystemObject代替Dir()功能。这只需要添加对Microsoft Scripting Runtime库

的引用

以上我提出以下代码：

Option Explicit

Sub main()
    Dim startPath As String
    Dim myLinkTargetPaths As New Collection, myLinkFilePaths As Collection

    startPath = "C:\myPath\"

    Set myLinkFilePaths = GetLinksPaths(startPath) 'first get the collection of all links path
    Set myLinkTargetPaths = GetLinksTarget(myLinkFilePaths) ' then get the collection of all links TargetPaths

End Sub


Function GetLinksTarget(myLinkFilePaths As Collection) As Collection
    Dim myColl As New Collection
    Dim element As Variant

    With CreateObject("Wscript.Shell")
        For Each element In myLinkFilePaths
            myColl.Add .CreateShortcut(element).TargetPath & "\"
        Next element
    End With
    Set GetLinksTarget = myColl
End Function     


Function GetLinksPaths(startPath As String) As Collection

    Dim objFso As FileSystemObject '<~~ requires adding reference to `Microsoft Scripting Runtime` library
    Dim objFile As File
    Dim objFolder As Folder
    Dim myColl As New Collection

    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.GetFolder(startPath)

    For Each objFile In objFolder.Files
        If objFso.GetExtensionName(objFile.Path) = "lnk" Then myColl.Add objFile.Path
    Next
    Set GetLinksPaths = myColl

End Function

相反，如果你想继续使用Dir()函数，那么只需更改GetLinksPaths()函数，如下所示：

Function GetLinksPaths(startPath As String) As Collection
    Dim tempPath As String
    Dim myColl As New Collection

    tempPath = Dir(startPath & "*.lnk")
    Do Until tempPath = vbNullString
        myColl.Add startPath & tempPath
        tempPath = Dir()
    Loop
    Set GetLinksPaths = myColl

End Function

顺便说一句：CreateObject("Wscript.Shell").CreateShortcut(Lnk)方法返回并且对象（WshShortcut或WshURLShortcut一个）不支持任何Close()方法，就像你在{ {1}}功能。因此，删除它以删除Getlnkpath()语句

的必要性

Answer 2

看起来您正在使用您的函数创建一个新的.lnk文件，然后您的dir命令会发现新创建的链接（已覆盖旧链接）。尝试在您的函数中使用GetShortcut而不是CreateShortcut。

VBA后续调用Dir（）返回相同的文件

2 个答案: