как создать папку и положить в нее текстовый файл в VBA

Question

Я делаю код, затем спрашиваю пользователя, куда он хочет поместить текстовый файл, созданный из листа Excel. если выбранная папка называется formatted file, то файл должен быть создан. если папка formatted file не существует, код должен создать файл с именем formatted Files, а затем создать в нем текстовый файл. текстовый файл содержит 4 столбца данных из Excel. На данный момент папка создана в нужном месте. код обновляется с правильным решением.

если есть способ упростить мой код, дайте мне знать !!

Вот мой фактический код:

       Sub register_formated_data()
    '
    ' register_formated_data Macro
    '
    Dim order As Object
    Dim Folder As Object
    Dim Folder_path As String
    Dim lastrow As Long

    Dim fSo As Object
    Dim myFile As Object

    FolderName = "Formated Files"
    Filename = "formated" & Right(Sheets(8).Cells(12, 6).Value, InStr(File_path, "\"))

    Dim FL As String ' FL is for file location

    Sheets(8).Cells(12, 12).Value = ""

    With Application.FileDialog(msoFileDialogFolderPicker)   '
        .Title = "Select where you want the folder to be"  'Open the file explorer
        .InitialFileName = ThisWorkbook.path & "\"         'for you to select
        .InitialView = msoFileDialogViewDetails            'the file you want
        .AllowMultiSelect = True                           'to add the txt file
        .Show                                              '

        On Error GoTo PROC_EXIT
        If Not .SelectedItems(1) = vbNullString Then FL = .SelectedItems(1)

    End With

    Sheets(8).Cells(12, 12).Value = FL

    Folder_path = FL + "\" + FolderName

Set fSo = CreateObject("Scripting.FileSystemObject")
If Not fSo.FolderExists(Folder_path) Then
    fSo.CreateFolder (Folder_path)
    If fSo.FolderExists(Folder_path) Then
        Set fSo = CreateObject("Scripting.FileSystemObject")
        Set myFile = fSo.CreateTextFile(Folder_path + "\" + Filename, True)

        myFile.WriteLine "Error"

        myFile.Close
        Set fSo = Nothing
    End If
Else
    If fSo.FolderExists(Folder_path) Then
    Set fSo = CreateObject("Scripting.FileSystemObject")
    Set myFile = fSo.CreateTextFile(Folder_path + "\" + Filename, True)

    myFile.WriteLine "Error"

    myFile.Close
    Set fSo = Nothing
    End If
End If


PROC_EXIT:
End Sub

Answer 1

Когда FL выбирается с помощью FileDialog, кажется, вы пытаетесь создать папку FL, когда она уже существует.

Использование fSo.CreateFolder(FL).Name = FolderName эквивалентно

folder = fSo.CreateFolder(FL) folder.Name = FolderName

Так что вам нужно заменить его на fSo.CreateFolder(FolderName).

Исправленный кодовый блок тогда:

Set fSo = CreateObject("Scripting.FileSystemObject")
If Not fSo.FolderExists(Folder_path) Then
    fSo.CreateFolder(Folder_path)          
    If fSo.FolderExists(Folder_path) Then
        Set fSo = CreateObject("Scripting.FileSystemObject")
        Set myFile = fSo.CreateTextFile(Folder_path + "\" + Filename, True)

        myFile.WriteLine "Error"

        myFile.Close
        Set fSo = Nothing
    End If
End If