Warning: file_get_contents(/data/phpspider/zhask/data//catemap/1/ms-access/4.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Ms access 循环指定位置中的所有快捷方式并返回目标路径_Ms Access_Ms Access 2007_Vba - Fatal编程技术网

Ms access 循环指定位置中的所有快捷方式并返回目标路径

Ms access 循环指定位置中的所有快捷方式并返回目标路径,ms-access,ms-access-2007,vba,Ms Access,Ms Access 2007,Vba,是否可以循环指定位置中的所有快捷方式(.lnk)并返回.TargetPath。如果快捷方式目标与条件匹配,则可以在快捷方式上生成操作 要删除所有快捷方式,我将使用以下命令: Public Sub deleteAllShortcuts() Dim shortCutPath As String ' compName = Computer Name, recordDirShort = directory where the shortcut lnks are shortCutPath

是否可以循环指定位置中的所有快捷方式(.lnk)并返回.TargetPath。如果快捷方式目标与条件匹配,则可以在快捷方式上生成操作

要删除所有快捷方式,我将使用以下命令:

Public Sub deleteAllShortcuts()
  Dim shortCutPath As String
  '   compName = Computer Name, recordDirShort = directory where the shortcut lnks are
  shortCutPath = compName & recordDirShort
  shortCutPath = shortCutPath & "*.lnk"
  On Error Resume Next
    Kill shortCutPath
  On Error GoTo 0
End Sub 
Public Sub deleteShortcutByTarget(targetFolderName As String)
Dim strDocPath As String
Dim strTarget As String
Dim obj As Object
Dim shortcut As Object
Dim objFso As Object
Dim objFolder As Object
Dim objFile  As Object

Set obj = CreateObject("WScript.Shell")
Set objFso = CreateObject("Scripting.FileSystemObject")

strDocPath = compName & recordDirShort

Set objFolder = objFso.GetFolder(strDocPath)
Set objFile = objFolder.Files

For Each objFile In objFolder.Files

 If objFso.GetExtensionName(objFile.Path) = "lnk" Then
  Set shortcut = obj.CreateShortcut(objFile.Path)
  strTarget = shortcut.TargetPath
  shortcut.Save
   If strTarget = strDocPath & targetFolderName Then
     Kill objFile.Path
   End If
 End If

Next

Set obj = Nothing
Set objFile = Nothing
Set objFso = Nothing
Set objFolder = Nothing
Set shortcut = Nothing

End Sub
我不知道如何使用上面的循环遍历目录中的所有快捷方式

如果您在上述方面有任何帮助,我们将不胜感激 干杯


Noel

在Access中,您可以使用Dir()函数。应该是这样的:

  Dim strLink As String

  strLink = Dir(shortCutPath & "*.lnk")
  Do Until Len(strLink)=0
    Kill strLink
    strLink = Dir()
  Loop

不过,Dir()并不能在所有情况下都很好地处理网络路径,因此您可能希望改用文件系统对象。它的功能更加广泛,与网络的配合也更好。我只是偶尔使用它,所以不要让代码触手可及,但请看一看——您可能不会有任何问题,因为对象模型设计得非常清晰。

希望这可能对某些人有好处。 要通过shorcut目标删除快捷方式,我使用了以下方法:

Public Sub deleteAllShortcuts()
  Dim shortCutPath As String
  '   compName = Computer Name, recordDirShort = directory where the shortcut lnks are
  shortCutPath = compName & recordDirShort
  shortCutPath = shortCutPath & "*.lnk"
  On Error Resume Next
    Kill shortCutPath
  On Error GoTo 0
End Sub 
Public Sub deleteShortcutByTarget(targetFolderName As String)
Dim strDocPath As String
Dim strTarget As String
Dim obj As Object
Dim shortcut As Object
Dim objFso As Object
Dim objFolder As Object
Dim objFile  As Object

Set obj = CreateObject("WScript.Shell")
Set objFso = CreateObject("Scripting.FileSystemObject")

strDocPath = compName & recordDirShort

Set objFolder = objFso.GetFolder(strDocPath)
Set objFile = objFolder.Files

For Each objFile In objFolder.Files

 If objFso.GetExtensionName(objFile.Path) = "lnk" Then
  Set shortcut = obj.CreateShortcut(objFile.Path)
  strTarget = shortcut.TargetPath
  shortcut.Save
   If strTarget = strDocPath & targetFolderName Then
     Kill objFile.Path
   End If
 End If

Next

Set obj = Nothing
Set objFile = Nothing
Set objFso = Nothing
Set objFolder = Nothing
Set shortcut = Nothing

End Sub

为建议干杯@David-W-Fenton仔细查看了文件系统对象,找到了下面的解决方案。