如何将条件从一个文件夹移动到另一个文件夹?

时间:2014-03-07 09:37:25

标签: excel vba excel-vba

有一个就绪脚本可以计算所选文件夹中工作簿中的行数。如果任何工作簿中的行数超过1,则会复制此工作簿并将其保存到另一个文件夹中。

    Sub OpenFiles()
    Dim MyFolder As String
    Dim MyFile As String
    Dim TargetWB As Workbook

    MyFolder = GetFolder("C:\Users\user\Desktop") 
    MyFile = Dir(MyFolder & "*.*")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Do While MyFile <> ""
        Set TargetWB = Workbooks.Open(Filename:=MyFolder & "\" & MyFile & "*.*")
        With TargetWB
            If CountUsedRows(TargetWB) > 1 Then
                .SaveAs "C:\Users\user\Desktop\vba\" & MyFile
            End If
            .Close
        End With
    MyFile = Dir
    Loop

    'Workbooks.Close savechanges:=False

   Shell "explorer.exe C:\Users\user\Desktop\vba", vbMaximizedFocus 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    End Sub


Function GetFolder(strPath As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Function CountUsedRows(Wbk As Workbook) As Long
    Dim WS As Worksheet
    Set WS = Wbk.Sheets(1)
    CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row 
End Function

是否可以将move一本Worbook发送到其他文件夹,如果它包含多于一行,则该文件夹需要处理。

是否可以使用类似Workbooks.Close savechanges:=False之类的内容来计算行数后关闭所选的工作簿?谢谢!

1 个答案:

答案 0 :(得分:0)

您可以使用MoveFile对象的FileSystemObject方法轻松移动文件。要在早期绑定中使用此类型,请在VBA项目中添加对Microsoft Sripting Runtime的引用。