从打开所有文件夹的循环中排除此工作簿
我有这个问题。 我有一个macros让我select我想要的文件夹,然后我有一个循环打开所有的Excel文件,我想排除这个工作簿(包含macros),所以我的想法是从名称中排除或从types(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
由于我的评论更像是一个答案 – 我已经在这里添加了。 你应该可以粘贴进去。 我还添加了一些缩进,并通过Next
控件添加了variables名 – 我认为这样更容易阅读
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