Question

您好，我正在尝试将文件从源文件复制到目标文件夹。但我收到错误＆＃34;错误的文件名或号码＆＃34;当我运行它。

这是我的代码：

Option Explicit
Dim srcFolder, trgFolder

srcFolder = "\\sunpowercorp.com\spap\SPMM-QA\Public-Read_Write\SPMM QA Documents\Dominic Yumul\Toshiba Monthly Quality Report"
trgFolder = "http:\\dms\departments\QUALITY\Quality Ops in the Box\Quality Ops in the Box library\025 SPMM QA Staff Documents\Toshiba Monthly Quality Report"

CopyFilesAndFolders srcFolder, trgFolder
WScript.Quit

Sub CopyFilesAndFolders(ByVal strSource, ByVal strDestination)
    Dim ObjFSO, ObjFolder, ObjSubFolder, ObjFile, files
    Dim TargetPath
    Set ObjFSO = CreateObject("scripting.filesystemobject")
    'connecting to the folder where is going to be searched
    Set ObjFolder = ObjFSO.GetFolder(strSource)
    TargetPath = Replace (objFolder.path & "\", strSource, strDestination,1,-1,vbTextCompare)
    If Not ObjFSO.FolderExists (TargetPath) Then ObjFSO.CreateFolder (TargetPath)
    Err.clear
    On Error Resume Next
    'Check all files in a folder
    For Each objFile In ObjFolder.files
        If Err.Number <> 0 Then Exit For 'If no permission or no files in folder
        On Error goto 0
        If CheckToCopyFile (objFile.path, TargetPath & "\" & objFile.name) Then 
            objFSO.copyfile objFile.path, TargetPath & "\" & objFile.name, True
        End If
    Next
    'Recurse through all of the subfolders
    On Error Resume Next
    Err.clear
    For Each objSubFolder In ObjFolder.subFolders
        If Err.Number <> 0 Then Exit For 'If no permission or no subfolder in folder
        On Error goto 0
        'For each found subfolder there will be searched for files
        CopyFilesAndFolders ObjSubFolder.Path & "\", TargetPath & ObjSubFolder.name & "\"
    Next
    Set ObjFile = Nothing
    Set ObjSubFolder = Nothing
    Set ObjFolder = Nothing
    Set ObjFSO = Nothing
End Sub

Function CheckToCopyFile(ByVal strSourceFilePath, ByVal strDestFilePath)
    Dim oFSO, oFile, SourceFileModTime, DestFileModTime
    CheckToCopyFile = True
    Set oFSO = CreateObject("scripting.filesystemobject")
    If Not oFSO.FileExists (strDestFilePath) Then Exit Function
    Set oFile = oFSO.GetFile (strSourceFilePath)
    SourceFileModTime = oFile.DateLastModified
    Set oFile = Nothing
    Set oFile = oFSO.GetFile (strDestFilePath)
    DestFileModTime = oFile.DateLastModified
    Set oFile = Nothing
    If SourceFileModTime =< DestFileModTime Then CheckToCopyFile = False
    Set oFSO = Nothing
End Function

我不知道我收到错误的是哪一行。

Answer 1

在Windows Vista及更高版本上，您应该能够map SharePoint库使用WebDAV来驱动字母，如this blog post中所述：

Set net = CreateObject("WScript.Network")
net.MapNetworkDrive "X:", "\\sp.example.org@SSL\site\Shared Documents\"

然后使用FileSystemObject方法将文件复制到映射的驱动器。

将文件从源文件夹复制到目标文件夹

1 个答案: