简体   繁体   中英

Exclude this workbook from a loop that open all folder

i have an issue on this . I have a macro that let me select the folder i want and then i have a loop on it which opens all excel files in it i want to exclude this workbook (the one containing the macro) so my idea was to exclude from the name or from the type (xlsm). any idea on the method to apply to solve it ? I thougt to use <> with a condition but i dont really know where and how to place it .

Here's the code Thanks for your help

  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

Since my comment turned out more like an answer - I've added it here. You should be able to paste it in and go. I also added in some indentation, and added the variable names by the Next controls - I think it's easier to read that way

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM