Как скопировать содержимое столбцов внутри текстового файла с помощью VBA

Question

Итак, я хочу взять данные из файла Excel и скопировать их в текстовый файл. данные находятся на трех столбцах, и я хочу разделить столбцы пробелами. Сейчас у меня ошибка bad file mode в строке со стрелкой. Здесь я оставлю указанную c часть моего кода, которая беспокоит меня, и весь код, который у меня есть, я знаю, что у меня должно быть Open newfilepath For output As #1 вместо Open newfilepath For Input As #1, но это дает мне ошибку 70 - здесь отказано` здесь часть что беспокоит меня:

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 + "\" + newfilename, True)

        Open newfilepath For Input As #1

        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows
            For j = 8 To 10 'columns

            cellValue = Rng.Cells(i, j).Value
            If j = Columns.Count Then
             Print #1, cellValue
        Else
         --> Print #1, cellValue,<--
        End If
            Next j
        Next i

        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 + "\" + newfilename, True)

    Open newfilepath For Input As #1

    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows
        For j = 8 To 10 'columns

            cellValue = Cells(i, j).Value
            If j = Columns.Count Then
             Print #1, cellValue
        Else
             Print #1, cellValue
        End If
        Next j
        Next i

    myFile.Close
    Set fSo = Nothing
    End If
End If

и вот весь мой код:

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 i, j As Integer
    Dim newfilepath As String
    Dim fSo As Object
    Dim myFile As Object
    Dim FL As String ' FL is for file location
    Dim last_row As Long

    newfilename = "formated " & Right(Sheets(8).Cells(6, 12).Value, Len(Sheets(8).Cells(6, 12).Value) - InStrRev(Sheets(8).Cells(6, 12).Value, "\"))
    MsgBox newfilename, vbOKOnly, "name of the formated file"
    FolderName = "Formated Files"
    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
    newfilepath = Folder_path + "\" + newfilename
    'myfilepath = Folder_path & "\" & newfilename

    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 + "\" + newfilename, True)

            Open newfilepath For Input As #1

            For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows
                For j = 8 To 10 'columns

                cellValue = Rng.Cells(i, j).Value
                If j = Columns.Count Then
                 Print #1, cellValue
            Else
                 Print #1, cellValue,
            End If
                Next j
            Next i

            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 + "\" + newfilename, True)

        Open newfilepath For Input As #1

        For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows
            For j = 8 To 10 'columns

                cellValue = Cells(i, j).Value
                If j = Columns.Count Then
                 Print #1, cellValue
            Else
                 Print #1, cellValue
            End If
            Next j
            Next i

        myFile.Close
        Set fSo = Nothing
        End If
    End If


PROC_EXIT:
End Sub

Answer 1

Попробуй так:

Dim ln As String, sep As String

'...

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FolderExists(Folder_path) Then fso.CreateFolder Folder_path

Set myfile = fso.CreateTextFile(Folder_path + "\" + newfilename, True)

For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'rows

    sep = "" '<< clear separator
    ln = ""  '<< clear line

    For j = 8 To 10 'columns
        ln = ln & sep & Rng.Cells(i, j).Value
        sep = " " '<<< populate separator after first value
    Next j

    myfile.writeline ln
Next i

myfile.Close
Set fso = Nothing

'...