Question

我正在浏览Sharepoint中的文件夹，并将所有.xlsx文件复制到桌面上的文件夹中。但是，查找路径似乎存在问题，导致错误76：找不到路径。

我已经遍历了该网站以及其他网站，以寻求解决方案的见解，但没有任何一个对我有用。

这是我当前的代码。

Dim path As String
Dim destination As String
Dim fso As Object
Dim obj_folder As Object
Dim obj_subfolder As Object
Dim file As Object

path = "\\mycompany.sharepoint.com\etc\etc"
destination = "C:\Users\adrian\Desktop\Practice\
Set fso = CreateObject("Scripting.filesystemobject")
Set obj_folder = fso.getfolder(path)

For Each obj_subfolder In obj_folder.subfolders
    For Each file In obj_subfolder.Files
        If InStr(1, file.Name, ".xlsx") Then
            Call fso.copyfile(file.path, destination & fso.getbasename(file) & ".xlsx")
        End If
    Next file
Next obj_subfolder

我尝试过的事情：

我启用了Microsoft脚本运行时参考。
我从fso.copyfile中删除了＆fso.getbasename（file）和“ .xlsx” Takeda_DigitalTrialPlatform_RFI v2.xlsx

Answer 1

尝试一下并修改您的偏好

'*****************************************************
'* Find files in subfolders
'* Ver. 0.99
'*
Option Explicit
Const ROOTFOLDER = "X:"             'Change as desired
Const EXTENSION = "xlsx"            'Change as desired
Const FILES = "*." & EXTENSION

Dim g_FolderCount As Integer
Dim g_FileCount As Integer

Sub Test()                      'Test code. Replace with your actual code
    Dim Path As String

    g_FileCount = 0
    g_FolderCount = 0
    Path = ROOTFOLDER
    GetSubFolders Path
    Debug.Print "Number of folders: " & g_FolderCount & ". Number of files: " & g_FileCount
End Sub
'****************************************************************
'* Recursive sub to find path and files in subfolders
'*
Sub GetSubFolders(Path As String)
    Dim FSO As Object           'Late binding: Scripting.FileSystemObject
    Dim myFolder As Object      'Late binding: Folder
    Dim mySubFolder As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myFolder = FSO.GetFolder(Path)
    If myFolder.SubFolders.Count <> 0 Then
        ProcessFiles Path                             'First branch (root)
        For Each mySubFolder In myFolder.SubFolders
            g_FolderCount = g_FolderCount + 1
            GetSubFolders mySubFolder.Path
        Next
    Else  'No more subfolders in Path, process files in current path
        ProcessFiles Path
    End If
End Sub
'*********************************************
'* Callback from GetSubFolders
'* Process files in the found folder
'*
Sub ProcessFiles(ByVal Path As String)
    Dim theFilePattern As String
    Dim theFile As String

    Path = Path & "\"
    theFilePattern = Path & FILES
    theFile = Dir(theFilePattern)
    While theFile <> ""    'Process each file here if needed
        g_FileCount = g_FileCount + 1
        Debug.Print Path & theFile
        theFile = Dir()    ' Next file if any
    Wend
End Sub

Answer 2

fso.GetBasenanme参数应该是字符串，而不是file对象，这很可能会导致副本出现问题。由于您已经知道文件是.xlsx，因此只需使用原始文件名并使用fso.BuildPath函数。

我会这样修改复制行： fso.copyfile(file.path, fso.BuildPath(destination, file.name))

为什么fso.copyfile方法找不到路径？

2 个答案: