Блог

Я пытаюсь использовать msoFileDialogFolderPicker в макросе Excel, чтобы выбрать место сохранения для моего пути к файлу. Однако, когда я успешно выполняю код, создается несколько csv, они помещают каталог выше местоположения, которое я выбрал в msoFileDialogFolderPicker. Я попытался использовать 2 для .SelectedItems (2) учитывая, что после того, как я попаду в каталог по умолчанию, мне нужно выполнить детализацию на одном уровне, прежде чем выбрать конечный пункт назначения папки, но безуспешно.

     Sub SplitRowsToMultipleCSVs()
    
    
    Const HeaderRow As Integer = 1
    Dim FolderPath As String
    
    Dim iRow As Integer, startSheet As Worksheet, tmpSheet As Worksheet
    Dim NumRows As Integer
    Dim s As String
      
    Application.ScreenUpdating = False
    
    s = Application.InputBox(Prompt:="Ticket Number", Type:=2)
    
    FolderPath = GetFolder()
    
    NumRows = ActiveSheet.UsedRange.Rows.Count
    iRow = HeaderRow   1
    Set startSheet = ActiveSheet
    Do Until iRow > NumRows
        Set tmpSheet = Worksheets.Add
        'copy the header
        startSheet.Range(HeaderRow amp; ":" amp; HeaderRow).EntireRow.Copy tmpSheet.Range("A1")
        'copy the data
        startSheet.Range(iRow amp; ":" amp; (iRow)).EntireRow.Copy tmpSheet.Range("A2")
        'save tmpSheet to CSV file
        tmpSheet.Move
        With ActiveWorkbook
            .SaveAs Filename:=FolderPath amp; "BillingNAVSetup_" amp; s amp; "_" amp; (iRow - 1) amp; ".csv", FileFormat:=xlCSVMSDOS
            .Close True
        End With
        iRow = iRow   1
    Loop
    
    Application.ScreenUpdating = True
    
End Sub


Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    '.InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function