Блог

У меня более 1000 папок старше года, которые содержат различные файлы, такие как файлы Excel и .txt. Я хотел бы создать программу vba в Excel, которая могла бы перемещать эти папки в папку архива, но я не уверен, как написать это в Excel, поскольку у меня нет большого опыта в том, чтобы vba делал что-то за пределами Excel. Это то, что я нашел в Google, и это работает, но для этого требуется исходная папка, и мне просто нужно переместить папки внутри нее.

 Private Sub CommandButton1_Click()

   Dim objFileSystem As Object
    Dim SourceFolder As String
    Dim TargetFolder As String
    
    'Path of the folder where files are locted
    SourceFolder = "C:DesktopSource Folder"
    TargetFolder = "C:DesktopTarget Folder"
          
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    
    'Check if source and target folder exists
    If objFileSystem.FolderExists(SourceFolder) = True And objFileSystem.FolderExists(TargetFolder) = True Then
        objFileSystem.MoveFolder Source:=SourceFolder, Destination:=TargetFolder
        MsgBox "Source folder has moved to target folder"
    Else
        MsgBox "Either source or target folder does not exist"
    End If


End Sub
 

Переместить вложенные папки

 Option Explicit

Private Sub CommandButton1_Click()
    
    Const SourceFolder As String = "C:DesktopSource Folder"
    Const TargetFolder As String = "C:DesktopTarget Folder"
    Dim Sep As String
    Sep = Application.PathSeparator
    Dim fdate As Long ' Account for leap year:
    fdate = Date - IIf(Day(Date) <> Day(Date - 365), 366, 365)
          
    With CreateObject("Scripting.FileSystemObject")
        If .FolderExists(SourceFolder) And .FolderExists(TargetFolder) Then
            Dim fsoFolder As Object
            Set fsoFolder = .GetFolder(SourceFolder)
            Dim fsoSubFolder As Object
            Dim n As Long
            For Each fsoSubFolder In fsoFolder.Subfolders
                If fsoSubFolder.DateCreated < fdate Then
                    n = n   1
                    .MoveFolder _
                      Source:=fsoSubFolder, _
                      Destination:=TargetFolder amp; Sep amp; fsoSubFolder.Name
                End If
            Next fsoSubFolder
            MsgBox "Moved " amp; n amp; " folder(s) to target folder"
        Else
            MsgBox "Either source or target folder does not exist"
        End If
    End With

End Sub