すべてのフォルダを開くループからこのワークブックを除外してください

Question

これに問題があります。私は、私が望むフォルダを選択できるようにするマクロを持っているし、私はそれにすべてのExcelファイルを開くそれにループを持っている 私のアイデアは名前から除外していたので、このブック（マクロを含むもの）またはタイプ（xlsm）から入力します。 それを解決するために適用する方法についての任意のアイデア？私は条件付きで<を使用するthougtしかし、私は本当にそれを配置する場所と方法を知っていません。私はここにそれを追加しました - 私のコメントは、より多くの答えのように判明したので

はここにあなたの助け

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 

Answer 1

のコード おかげです。あなたはそれを貼り付けることができるはずです。私はまた、いくつかのインデントに加え、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