如何将 FileSystemObject 添加到我的 VBA 以使用 Unicode 创建文本平面文件？

Question

我设法拼凑了这个 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

我无法让它工作。

Answer 1

请测试下一个代码。您没有回答我的澄清问题，但它可以使用上述评论假设。它从位于要处理的 sheet 上的 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

我在 sheet 上使用 ANSI 不支持的字符测试了上面的代码，它按预期工作。

请在测试后发送一些反馈，或者如果我在阅读您的问题后的假设不正确...

Answer 2

@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, False, 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

如何将 FileSystemObject 添加到我的 VBA 以使用 Unicode 创建文本平面文件？

How to add FileSytemObject to my VBA for creating text flat files in Unicode?

unicode

vba

text

flat-file