макрос для сохранения в формате csv

Автор Посетитель 17.02.2024, 17 февраля 2024, 08:57

Посетитель 17.02.2024

Подскажите как исправить макрос? В результате выбора пути файла и его названия в проводнике, далее выходит форма для указания имени файла без расширения, а потом выходит ошибка: "нет доступа к файлу ****.csv". Возможно, файл поврежден, находится на сервере, который не отвечает на запросы, или доступен только для чтения"

Sub МакросCSV()
    Dim ws As Worksheet
    Dim rng As Range
    Dim filePath As String
    Dim fileName As String
   
    ' Укажите лист с данными
    Set ws = ThisWorkbook.Sheets("Книг1")
   
    ' Укажите диапазон данных (1 и 3 столбец)
    Set rng = ws.Range("A2:C" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row)
   
    ' Откройте проводник для выбора пути и имени файла
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Выберите место сохранения и имя файла"
        .Show
        filePath = .SelectedItems(1)
    End With
   
    ' Создайте CSV-файл
    fileName = InputBox("Введите имя файла (без расширения):", "Имя файла")
    If fileName <> "" Then
        ' Создайте новую книгу и скопируйте в нее диапазон
        With Workbooks.Add
            rng.Copy .Sheets(1).Cells(1, 1)
            ' Сохраните новую книгу в формате CSV
            .SaveAs filePath & "\" & fileName & ".csv", xlCSV
            .Close False
        End With
    End If
End Sub

Администратор

Написал вам два письма на почту с заголовком "Письмо с Форума по VBA, Excel и Word". Написал именно на почту, а не на форум.

Здесь вам нужно выбрать папку, а вы работаете с файлом:
    ' Откройте проводник для выбора пути и имени файла
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Выберите место сохранения и имя файла"
        .Show
        filePath = .SelectedItems(1)
    End With

Так правильно:
    ' Откройте проводник для выбора папки
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите место сохранения"
        .Show
        filePath = .SelectedItems(1)
    End With