附加到文本文件VBA

Neha 发表于 Dev

内哈

我需要将值从选定的范围取到以逗号分隔的文本文件中并将其附加。以下代码在Set TS处给我一个错误。为什么？？

Sub Wri()

Dim myrng As Range
Dim Cell As Range

On Error Resume Next
Set myrng = Application.InputBox("Select range", Type:=8)
On Error GoTo 0

If myrng Is Nothing Then
    MsgBox "No cells selected"
    Exit Sub
End If

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fs, f, TS, s
Dim cellv As String

Set fs = CreateObject("Scripting.FileSystemObject")
fs.CreateTextFile "C:\Users\HP\Documents\fil.txt"
Set f = fs.GetFile("C:\Users\HP\Documents\fil.txt")
Set TS = f.OpenTextFile(myrng.Value, 8, True, 0)

For Each Cell In myrng
    cellv = Cell.Value
    TS.Write (cellv & Chr(44))
Next Cell

End Sub

登齐尔·纽曼

香港专业教育学院让您一个自定义的子，用这两个替换子-最后一个参数确定是否是一个追加，它也将处理新行：D

Sub writeCSV(ByVal thisRange As Range, ByVal filePath As String, Optional ByVal fileAppend As Boolean = False)
    Dim cLoop As Long, rLoop As Long
    Dim ff As Long, strRow As String

    ff = FreeFile
    If fileAppend Then
        Open filePath For Append As #ff
    Else
        Open filePath For Output As #ff
    End If

    For rLoop = 1 To thisRange.Rows.Count
        strRow = ""
        For cLoop = 1 To thisRange.Columns.Count
            If cLoop > 1 Then strRow = strRow & ","
            strRow = strRow & thisRange.Cells(rLoop, cLoop).Value
        Next 'cLoop
        Print #ff, strRow
    Next 'rLoop

    Close #ff
End Sub

Sub Wri()

Dim myrng As Range
Dim Cell As Range

On Error Resume Next
Set myrng = Application.InputBox("Select range", Type:=8)
On Error GoTo 0

If myrng Is Nothing Then
    MsgBox "No cells selected"
    Exit Sub
Else
    writeCSV myrng, "C:\Users\HP\Documents\fil.txt", True
End If

End Sub