如何使用 VBA 复制文本文件中列的内容

Question

So i want to take data from an Excel file and copy them in an text file. data are on three columns and i want to separate the columns by spaces. For now i'm having the bad file mode error on the line with the arrow. Here i'll leave the specific part of my code that is bothering me and all the code i have i know that i should have Open newfilepath For output As #1 instead of Open newfilepath For Input As #1 but it gives me error 70 àcces denied` here the part that bothering me :

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

and here's all my code:

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

Try like this:

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

'...