Question

共有2个共享驱动器。其中一个具有非常复杂的文件夹结构。我想将Share 1的整个文件夹结构复制到共享2.但是我不想制作重复文件，而是希望第二个共享中存在快捷方式或符号链接。我尝试使用Robocopy和mklink等现有工具来做到这一点，但未能达到效果。我们非常感谢您解决此问题的任何想法。

Answer 1

您可以通过使用filesystemobject在文件夹结构中工作来实现此目的，如果文件夹存在于目标中，则不执行任何操作并在该文件夹中为所有主机文件夹文件创建快捷方式。否则，无论如何都要创建文件夹并为托管文件创建快捷方式。

DoFolder子在所有子文件夹中向下滑动。 GetFN函数仅收集托管文件夹中所有文件的文件名。即使文件名中有句点。

这是一个有趣的程序，谢谢。

FolderShadows.vbs

Dim fso, HostFolder, DestFolder

'Host Folder - Folder must exist. 
HostFolder = "C:\From\Folder"

'Destination Folder - Folder must exist. 
DestFolder = "D:\To\Folder"

Set fso = CreateObject("Scripting.FileSystemObject")
DoFolder fso.GetFolder(HostFolder)
Sub DoFolder(Folder)
    Dim SubFolder
    If fso.folderexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder)) = False Then
        fso.createfolder(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder))
    End If
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    Dim File
    For Each File In Folder.Files
        Dim FileName, shortcut
        If (fso.fileexists(Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk") = False) Then
            FileName = Replace(fso.GetAbsolutePathName(Folder), HostFolder, DestFolder) & "\" & GetFN(File.Name) & ".lnk"
            Set shortcut = CreateObject("WScript.Shell").CreateShortcut(FileName)
            shortcut.Description = "Shortcut To " & File.Name
            shortcut.TargetPath = fso.GetAbsolutePathName(Folder) & "\" & File.Name
            shortcut.Save
        End If
    Next
End Sub
Function GetFN(FileName)
    Dim Result, i
    Result = FileName
    i = InStrRev(FileName, ".")
    If ( i > 0 ) Then
        Result = Mid(FileName, 1, i - 1)
    End If
    GetFN = Result
End Function

注意：此脚本可以按自动计划运行，因为它可以在找到新文件/文件夹时自动更新快捷方式和文件夹。

仅使用快捷方式复制复杂的文件夹结构

1 个答案: