簡體   English   中英

如何使用 VBA 復制文本文件中列的內容

[英]How to copy the content of columns inside a text file using VBA

所以我想從 Excel 文件中獲取數據並將它們復制到一個文本文件中。 數據在三列上,我想用空格分隔列。 現在,我在帶箭頭的行上遇到bad file mode錯誤。 在這里,我將留下困擾我的代碼的特定部分以及我知道的所有代碼,我應該將Open newfilepath For output As #1而不是Open newfilepath For Input As #1但它給了我錯誤 70 àcces在這里否認了困擾我的部分:

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

像這樣嘗試:

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

'...

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM