Есть ли такая вещь, как универсальный код поиска пути в Excel для Mac

Question

Я работаю над проектом очистки для отчетов об используемых приложениях.

Вот первая часть проекта, где мне нужна новая книга, чтобы забрать извлеченные отчеты Excel из папки.скопируйте конкретный лист (через окно сообщения ввода), измените имя листа в соответствии с отчетом приложения и вставьте его в новую книгу.

Поскольку эта макрокоманда будет доступна другим моим коллегам, мне бы хотелосьчтобы у меня было поле «выбрать путь к каталогу», чтобы они могли выбрать и выбрать путь к каталогу.

Я сделал основы, чтобы указать макрос непосредственно в определенном месте, чтобы выбрать файлы.Мой менеджер хочет, чтобы он мог выбирать путь к каталогу, если другой коллега использует этот же шаблон.

У нас есть команда Google drive, на которой хранятся файлы, поэтому, если код может извлечь файлы изкомандный диск вместо пользовательской загрузки в их систему будет отличным.

Sub CopySheets()

    Dim path As String
    Dim FileName As String
    Dim whichSheet As String

    path = "/Users/timothy.wong/Downloads/Project Clean Up/2019/"
    FileName = Dir(path & "*.xlsx")
    whichSheet = InputBox("Which month would you like to copy? Enter month (eg. Jan, Feb, Mar)")

    Do While FileName <> ""
        Workbooks.Open FileName:=path & FileName, ReadOnly:=True
        Sheets(whichSheet).Select
        ActiveWorkbook.ActiveSheet.Copy after:=ThisWorkbook.Sheets(1)
        Workbooks(FileName).Close
        ActiveSheet.Name = Left(FileName, Application.WorksheetFunction.Search(" ", FileName) - 1)
        FileName = Dir()

    Loop

End Sub

Базовый код работает хорошо, мне нужно сделать его немного более продвинутым.

Answer 1

Вы можете попробовать это:

Option Explicit
Sub CopySheets()

    Dim path As String
    Dim FileName As String
    Dim whichSheet As String
    Dim SheetNames As String
    Dim wb As Workbook

    path = GetFolder
    If path = vbNullString Then
        MsgBox "No folder was selected. Ending the procedure."
        End
    End If
    FileName = Dir(path & "*.xlsx")
    whichSheet = InputBox("Which month would you like to copy? Enter month (eg. Jan, Feb, Mar)")

    Do While FileName <> ""
        Set wb = Workbooks.Open(FileName:=path & FileName, ReadOnly:=True)
        On Error Resume Next
        If Len(wb.Sheets(whichSheet).Name) = 0 Then 'Here we handle an error on the inputname for the sheet.
        On Error GoTo 0
            SheetNames = GetSheetNames(wb)
            MsgBox "The input sheet does not exist in this workbook. The current worksheet names are: " & SheetNames
            whichSheet = InputBox("Which month would you like to copy? Enter month (eg. Jan, Feb, Mar)")
        End If
        With wb.Sheets(whichSheet)
            .Copy after:=ThisWorkbook.Sheets(1)
            .Close
        End With
        ThisWorkbook.Sheets(2).Name = Left(FileName, Application.WorksheetFunction.Search(" ", FileName) - 1)
        FileName = Dir()
    Loop

End Sub
Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Selecciona una carpeta"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing

End Function
Function GetSheetNames(wb As Workbook) As String

    Dim ws As Worksheet

    For Each ws In wb.Worksheets
        GetSheetNames = GetSheetNames & ", " & ws.Name
    Next ws

End Function