将文件移至Google Drive日期文件夹时触发Run-time Error 75求助

问题原因 #

Google Drive的本地映射盘是依赖云端同步的虚拟驱动器，VBA原生Name命令执行速度快，当文件数量超过50个时，同步机制来不及释放文件锁定或完成路径更新，就会触发路径/文件访问错误。

解决方案 #

1. 使用FileSystemObject替代原生Name命令 #

FileSystemObject对网络/虚拟驱动器的兼容性更强，还能更好地处理文件操作中的异常。

修改后的代码：

Sub moveAllFilesInDateFolder()
    Dim DateFold As String, fileName As String
    Const sFolderPath As String = "G:\My Drive\Source"
    Const dFolderPath As String = "G:\My Drive\Destination\07102022"
    Dim fso As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy")
    ' 创建目标文件夹（不存在则创建）
    If Not fso.FolderExists(DateFold) Then
        fso.CreateFolder DateFold
    End If
    
    fileName = Dir(sFolderPath & "\*.*")
    Do While fileName <> ""
        On Error Resume Next
        ' 移动文件，带错误重试
        fso.MoveFile Source:=sFolderPath & "\" & fileName, Destination:=DateFold & "\" & fileName
        ' 如果移动失败，等待1秒后重试
        If Err.Number <> 0 Then
            Err.Clear
            Application.Wait Now + TimeValue("00:00:01")
            fso.MoveFile Source:=sFolderPath & "\" & fileName, Destination:=DateFold & "\" & fileName
        End If
        On Error GoTo 0
        fileName = Dir
    Loop
    
    Set fso = Nothing
End Sub

2. 增加操作间隔（临时方案） #

在每次移动后增加短暂延迟，给Google Drive足够的同步时间，适合文件数量不是特别多的场景：

Sub moveAllFilesInDateFolder()
    Dim DateFold As String, fileName As String
    Const sFolderPath As String = "G:\My Drive\Source"
    Const dFolderPath As String = "G:\My Drive\Destination\07102022"
    
    DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy")
    If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
    
    fileName = Dir(sFolderPath & "\*.*")
    Do While fileName <> ""
        On Error Resume Next
        Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
        If Err.Number <> 0 Then
            Err.Clear
            Application.Wait Now + TimeValue("00:00:01")
            Name sFolderPath & "\" & fileName As DateFold & "\" & fileName
        End If
        On Error GoTo 0
        Application.Wait Now + TimeValue("00:00:00.5") ' 每次移动后等待0.5秒
        fileName = Dir
    Loop
End Sub

3. 提前检查文件状态 #

移动前确认文件未被锁定且可访问，避免因文件占用导致的错误：

Private Function IsFileAccessible(filePath As String) As Boolean
    Dim fileNum As Integer
    On Error Resume Next
    fileNum = FreeFile()
    Open filePath For Input Lock Read Write As #fileNum
    Close #fileNum
    IsFileAccessible = (Err.Number = 0)
    On Error GoTo 0
End Function

Sub moveAllFilesInDateFolder()
    Dim DateFold As String, fileName As String
    Const sFolderPath As String = "G:\My Drive\Source"
    Const dFolderPath As String = "G:\My Drive\Destination\07102022"
    
    DateFold = dFolderPath & "\" & Format(Date, "ddmmyyyy")
    If Dir(DateFold, vbDirectory) = "" Then MkDir DateFold
    
    fileName = Dir(sFolderPath & "\*.*")
    Do While fileName <> ""
        Dim sourcePath As String
        sourcePath = sFolderPath & "\" & fileName
        ' 等待文件可访问
        Do While Not IsFileAccessible(sourcePath)
            Application.Wait Now + TimeValue("00:00:01")
        Loop
        ' 执行移动
        On Error Resume Next
        Name sourcePath As DateFold & "\" & fileName
        If Err.Number <> 0 Then
            Err.Clear
            Application.Wait Now + TimeValue("00:00:01")
            Name sourcePath As DateFold & "\" & fileName
        End If
        On Error GoTo 0
        fileName = Dir
    Loop
End Sub

注意事项 #

• 确保Google Drive客户端处于正常同步状态，没有暂停或报错
• 避免在移动过程中手动操作Google Drive的文件或文件夹
• 若文件数量极大，建议分批次移动，比如每50个文件后暂停几秒

内容的提问来源于stack exchange，提问作者Salman Shafi