问题描述
我已经设法将这个 VBA 拼凑起来，它从 excel 中获取数据并将其转换为 .txt 平面文件。它完全按照我的需要工作，但我想对其进行更改，以便将最终结果保存为 Unicode 而不是 ANSI。
我已经阅读了一些资料，我不断返回的答案是使用 FileSystemObject。我在这里找到了一个 VBA 可以完美地完成这项工作，但我一生都无法弄清楚如何将它合并到我现有的代码中。有人可以给我一些指点吗？
这是我当前的代码：
' Defines everything first. So,from B2,across and down.
LastRow = Sheets("Pricing").Range("B" & Rows.Count).End(xlUp).Row
LastColumn = Sheets("Pricing").Cells(2,Columns.Count).End(xlToLeft).Column
' File name,path to save to and delimiter.
file = Sheets("Pricing").TextBox1 & ".txt"
If TextBox1.Value = "" Then MsgBox "What we calling it genius?",vbQuestion
If TextBox1.Value = "" Then Exit Sub
Path = "C:\Users\me.me\Desktop\Files\"
Delimeter = "|"
' The magic bit.
myFileName = Path & file
FN = FreeFile
Open myFileName For Output As #FN
For Row = 2 To LastRow
For Column = 2 To LastColumn
If Column = 2 Then Record = Trim(Cells(Row,Column)) Else Record = Record & Delimeter & Trim(Cells(Row,Column))
Next Column
Print #FN,Record
Next Row
Close #FN
MsgBox "BOOM! LOOKIT ---> " & myFileName
' Opens the finished file.
Dim fso As Object
Dim sfile As String
Set fso = CreateObject("shell.application")
sfile = "C:\Users\me.me\Desktop\Files\" & Sheets("Pricing").TextBox1 & ".txt"
fso.Open (sfile)
这就是我一直在尝试合并的内容（非常感谢 MarkJ 在另一个问题上发布此内容）：
Dim fso As Object,MyFile As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile("c:\testfile.txt",False,True) 'Unicode=True'
MyFile.WriteLine("This is a test.")
MyFile.Close
我就是无法让它工作。
解决方法
请测试下一个代码。您没有回答我的澄清问题，但它可以使用上述评论假设。它从位于要处理的工作表上的 activeX 文本框中获取文件名。对于大范围，代码应该比你的更快，避免在所有单元格之间迭代：
Sub SaveAsUnicode()
Dim shP As Worksheet,iRow As Long,Record As String,Delimeter As String
Dim file As String,myFileName As String,path As String,txtB As MSForms.TextBox
Dim rng As Range,lastCell As Range,arr,arrRow
Dim fso As Object,MyFile As Object,shApp As Object
Set shP = Worksheets("Pricinig")
Set txtB = shP.OLEObjects("TextBox1").Object 'it sets an activeX sheet text box
file = txtB.Text & ".txt"
If txtB.value = "" Then MsgBox "What we calling it genius?",vbQuestion: Exit Sub
Set lastCell = shP.cells.SpecialCells(xlCellTypeLastCell) 'last cell of the sheet
Set rng = shP.Range("A2",lastCell) 'create the range to be processed
arr = rng.value 'put the range in an array
path = "C:\Users\me.me\Desktop\Files\" 'take care to adjust the path!
myFileName = path & file
Delimeter = "|"
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile(myFileName,False,True) 'open the file to write Unicode:
For iRow = 1 To UBound(arr) 'itereate between the array rows
arrRow = Application.Index(arr,iRow,0) 'make a slice of the currrent arrray row
Record = Join(arrRow,Delimeter) 'join the iD obtained array,using the set Delimiter
MyFile.WriteLine (Record) 'write the row in the Unicode file
Next iRow
MyFile.Close 'close the file
'open the obtained Unicode file:
Set shApp = CreateObject("shell.application")
shApp.Open (myFileName)
End Sub
我使用 ANSI 不支持的字符在工作表上测试了上述代码，它按预期工作。
请在测试后发送一些反馈，或者如果我在阅读您的问题后的假设不正确...
,@FaneDuru，这就是我最终整理出来的，对我来说效果很好。再次感谢您的帮助。
Private Sub FlatButton_Click()
'Does all the setup stuff.
Dim fso As Object,MyFile As Object
Dim MyFileName As String
Dim txtB As MSForms.TextBox
Set shP = Worksheets("Pricing")
Set txtB = shP.OLEObjects("TextBox1").Object
file = txtB.Text & ".txt"
If txtB.Value = "" Then MsgBox "What we calling it?",vbQuestion: Exit Sub
' Defines the range. So,from B2,across and down.
LastRow = Sheets("Pricing").Range("B" & Rows.Count).End(xlUp).Row
LastColumn = Sheets("Pricing").Cells(2,Columns.Count).End(xlToLeft).Column
'File details.
path = "C:\Users\me.me\Blah\Blah\"
MyFileName = path & file
Delimeter = "|"
' The magic bit.
Set fso = CreateObject("Scripting.FileSystemObject")
Set MyFile = fso.CreateTextFile(MyFileName,True) '<==== This defines the Unicode bit.
For Row = 2 To LastRow
For Column = 2 To LastColumn
If Column = 2 Then Record = Trim(Cells(Row,Column)) Else Record = Record & Delimeter & Trim(Cells(Row,Column))
Next Column
MyFile.WriteLine (Record)
Next Row
MyFile.Close
MsgBox "BOOM! ---> " & MyFileName
'Option to open the finished product.
If ActiveSheet.CheckBox2.Value = True Then
Set shApp = CreateObject("shell.application")
shApp.Open (MyFileName)
End If
End Sub