从打开所有文件夹

时间:2016-11-20 17:38:26

标签: excel vba

我有一个问题。我有一个宏,让我选择我想要的文件夹然后我有一个循环,它打开其中的所有excel文件 我想要排除这个工作簿(包含宏的那个),所以我的想法是从名称或类型(xlsm)中排除。 关于申请解决方法的任何想法?我想使用<>有条件,但我真的不知道在哪里以及如何放置它。

这是代码 谢谢你的帮助

  Sub macro3()
    Dim fso As Object, Dossier As Object, NomDossier, feuille As Worksheet
    Dim pvtTable As Object



    Dim Files As Object, File As Object, i As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
    NomDossier = ChoisirDossier
    If NomDossier = "" Then Exit Sub
    Set Dossier = fso.getfolder(NomDossier)
    Set Files = Dossier.Files

        If Files.Count <> 0 Then
            For Each File In Files
                 Workbooks.Open Filename:=File


            For Each feuille In Worksheets
              If feuille.Name Like ("*TCD RETARD*") Then

            feuille.Activate
            Range("D14").Select


        ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _
     Sheets(2).ListObjects(1)

    ActiveWorkbook.RefreshAll
    ActiveWorkbook.Save
    ActiveWorkbook.Close



End If
Next
Next
End If


End Sub
Function ChoisirDossier()
Dim objShell, objFolder, chemin, SecuriteSlash
Set objShell = CreateObject("Shell.Application")
Set objFolder = _
objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
If objFolder.Title = "Bureau" Then
chemin = "C:WindowsBureau"
End If
If objFolder.Title = "" Then
chemin = ""
End If
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoisirDossier = chemin
End Function

1 个答案:

答案 0 :(得分:0)

由于我的评论更像是一个答案 - 我在这里添加了它。你应该可以将其粘贴进去。我还添加了一些缩进,并通过Next控件添加了变量名称 - 我认为这样更容易阅读

Sub macro3()
    Dim fso As Object, Dossier As Object, NomDossier, feuille As Worksheet
    Dim pvtTable As Object



    Dim Files As Object, File As Object, i As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
    NomDossier = ChoisirDossier
    If NomDossier = "" Then Exit Sub

    Set Dossier = fso.getfolder(NomDossier)
    Set Files = Dossier.Files

    If Files.Count <> 0 Then
        For Each File In Files
            If File <> ThisWorkbook.FullName Then
                Workbooks.Open Filename:=File

                 For Each feuille In Worksheets
                     If feuille.Name Like ("*TCD RETARD*") Then

                     feuille.Activate
                     Range("D14").Select

                     ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:=Sheets(2).ListObjects(1)

                     ActiveWorkbook.RefreshAll
                     ActiveWorkbook.Save
                     ActiveWorkbook.Close

                     End If
                Next feuille
            End If
        Next File
    End If
End Sub

Function ChoisirDossier()
    Dim objShell, objFolder, chemin, SecuriteSlash
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = _
    objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
    On Error Resume Next
    chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
    If objFolder.Title = "Bureau" Then
        chemin = "C:WindowsBureau"
    End If
    If objFolder.Title = "" Then
        chemin = ""
    End If
    SecuriteSlash = InStr(objFolder.Title, ":")
    If SecuriteSlash > 0 Then
        chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
    End If
    ChoisirDossier = chemin
End Function