почему мой подстановочный знак не регистрируется в каталоге? - PullRequest
0 голосов
/ 23 мая 2019

У меня есть скрипт зацикливания подпапок, который определяет, является ли Cells(2,3) пустым, и затем продолжает удаление столбца, если так.

У меня есть подстановочный знак *, чтобы не называть какие-либо файлы, только расширения.Почему эта строка: MyFile = "*.xlsx" не подбирает реальные имена файлов?Он просто отображается как *.xlsx внутри цикла и выходит из подпрограммы, потому что ничего не найдено.

Отредактированный код на основе ответа:

Sub LoopSubfoldersAndFiles()

    Dim folder As Object
    Dim subfolders As Object
    Dim MyFile As String
    Dim wb As Workbook
    Dim currentfile As Object, currentfolder As Object

    With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    End With


    Set subfolders = folder.subfolders
    MyFile = "*.xlsx"

    For Each subfolders In subfolders

    Set CurrentFile = subfolders.Files

    With New FileSystemObject ' reference Microsoft Scripting Runtime library

        Dim root As folder
        Set root = .GetFolder("C:\Users\pp87255\Desktop\JNav Rest\05.23.2019")

        Dim subFolder As folder
        For Each subFolder In root.subfolders

            Dim currentfolder As folder
            For Each currentfolder In subFolder.subfolders

                Dim currentfile As File
                For Each currentfile In currentfolder.Files
                    If currentfile.Name Like "*.xlsx" Then
                        Dim wb As Workbook
                        Set wb = Application.Workbooks.Open(currentfile.Path)
                        If wb.Sheets(1).Cells(2, 3).Value2 = "" Then
                            Columns(3).EntireColumn.Delete
                        End If
                    End If
                Next
            Next
        Next
    End With


    Next

    Set folder = Nothing
    Set subfolders = Nothing

With Application
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

End Sub

Ответы [ 2 ]

1 голос
/ 23 мая 2019
If CurrFile.Name = MyFile Then

Если MyFile равно "*.xlsx", оператор сравнения = правильно говорит: «Нет, не совпадает».

Вам нужно заменить этот оператор на оператор Like с предупреждением о том, что вам понадобится литеральное выражение справа:

If CurrFile.Name Like "*.xlsx" Then

Это должно работать как задумано ... до этой части:

Workbooks.Open(subfolders.Path & "\" & MyFile)

Вы, вероятно, хотите использовать CurrFile там (Workbooks.Open не ожидает подстановочного знака в имени файла там) ... но это странно и неоднозначно:

For Each CurrFile In CurrFile

Не делай этого. Вместо этого объявите новую переменную или измените существующую в той же области. То же самое здесь:

For Each subfolders In subfolders

Вы хотите For Each subFolder In subFolders, затем For Each currFile In currFiles, может быть - или лучше:

With New FileSystemObject ' reference Microsoft Scripting Runtime library

    Dim root As Folder
    Set root = .GetFolder("C:\Users\pp87255\Desktop\JNav Rest\05.23.2019")

    Dim subFolder As Folder
    For Each subFolder In root.SubFolders

        Dim currentFolder As Folder
        For Each currentFolder In subFolder.SubFolders

            Dim currentFile As File
            For Each currentFile In currentFolder.Files
                If currentFile.Name Like "*.xlsx" Then
                    Dim wb As Workbook
                    Set wb = Application.Workbooks.Open(currentFile.Path)
                    '...
                End If
            Next
        Next
    Next
End With

Работать с поздним связыванием сложно, если вы не знакомы с задействованными библиотеками. Хорошей новостью является то, что нет никаких причин для позднего связывания библиотеки Scripting (это та же самая версия на каждом Windows-боксе, когда-либо созданном в этом веке) - так что перейдите в «Инструменты»> «Ссылки» и проверьте библиотеку «Среда выполнения сценариев Microsoft».

0 голосов
/ 23 мая 2019

Я переназначил этот код с "www.thespreadsheetguru.com".Он просматривает все файлы в папке, к которой я перемещаюсь, и форматирует их.

Private Sub FormatAllFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim WB As Workbook
Dim myPath As String
Dim MyFile As String
Dim myFileName As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim regionNumber As String

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "SELECT THE FOLDER WITH REPORT COLLECTION WORKBOOKS TO BE FORMATTED"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = ".xlsx"

'Target Path with Ending Extention
  MyFile = Dir(myPath)
  'branchLocation = fso.GetBaseName(Right(myFile, Len(myFile) - InStr(myFile, "_")))

  GetSaveFileLocation

'Loop through each Excel file in folder
  Do While MyFile <> ""

    Application.DisplayAlerts = False

    myFileName = fso.GetBaseName(MyFile)

    'Set variable equal to opened workbook
      Set WB = Workbooks.Open(fileName:=myPath & MyFile)

      fName = myFileName & "_Formatted"
      saveFileName = mySavePath & fName & myExtension

      If WB.Application.ProtectedViewWindows.Count > 0 Then
        WB.Application.ActiveProtectedViewWindow.Edit
      End If

      ExecutiveReportFormatting

      regionNumber = getRegionNumber(myFileName)

      WB.BuiltinDocumentProperties("Comments").Value = regionNumber

    'Close Workbook
    With WB
        .SaveAs saveFileName
        .Close
    End With

    'Get next file name
      MyFile = Dir

  Loop

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True



End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...