附加到文本文件 VBA
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/22428667/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Append to Text File VBA
提问by Neha
I need to take values from a selected range to a comma delimited text file and append them. The code below gives me an error at Set TS. Why??
我需要将选定范围中的值提取到逗号分隔的文本文件中并附加它们。下面的代码在设置 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
回答by Denzil Newman
Ive made you a custom sub, replace the sub with these two - the last param determins if it is an append or not and it will handle the new lines too :D
我给你做了一个自定义子，用这两个替换子 - 最后一个参数确定它是否是一个附加，它也会处理新行：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
回答by Denzil Newman
try
尝试
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 TS = fs.OpenTextFile("C:\Users\HP\Documents\fil.txt", 8, True, 0)
For Each Cell In myrng
cellv = Cell.Value
TS.Write (cellv & Chr(44))
Next Cell
End Sub
回答by Denzil Newman
to add all data to a "list"
将所有数据添加到“列表”
Sub writeList(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
Dim tCell As Range
ff = FreeFile
If fileAppend Then
Open filePath For Append As #ff
Else
Open filePath For Output As #ff
End If
For Each tCell In thisRange
Print #1, tCell.Value
Next tCell
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
writeList myrng, "C:\Users\HP\Documents\fil.txt", True
End If
End Sub
回答by Denzil Newman
ah right try changing the call writeList to writeHList then and use this sub:
啊对，尝试将调用 writeList 更改为 writeHList 然后并使用此子项：
Sub writeHList(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
Dim tCell As Range
Dim strLine
ff = FreeFile
If fileAppend Then
Open filePath For Append As #ff
Else
Open filePath For Output As #ff
End If
For Each tCell In thisRange
If strLine = "" Then
strLine = tCell.Value
Else
strLine = strLine & "," & tCell.Value
End If
Next tCell
Print #1, tCell.Value
Close #ff
End Sub
