阅读VBA中的国际/特殊字符

时间:2023-01-06 15:24:56

This is my first time using VBA in excel to create a macro which will read an excel spreadsheet row by row and for each row create a textfile including information from the columns. My macro works well for normal text, but from time to time there is foreign text in some of the spreadsheet cells.

这是我第一次在excel中使用VBA创建一个宏,它将逐行读取excel电子表格行,并为每一行创建一个包含来自列的信息的textfile。我的宏在正常文本中很好用,但有时在一些电子表格单元中有外文文本。

As soon as my macro tries to write this to the textfile it falls over. The first problem appears to be reading the values in (looking in the debugger the foreign text appears as '?' question marks), it then fails when trying to write these question marks to the textfile.

当我的宏试图将它写入文本文件时,它就会崩溃。第一个问题似乎是读取其中的值(在调试器中查找,外文本显示为'?“问号”),当试图将这些问号写到文本文件时,它会失败。

This is a snippet of the code that reads the values in from a row to a string array

这是从一行读取值到字符串数组的代码片段

    Set oFS = CreateObject("Scripting.Filesystemobject")
    For Each rID In oSh.UsedRange.Columns("A").Cells
        For Each rValue In oSh.UsedRange.Rows(rowCount).Cells
            ReDim Preserve columnValues(columnCount)
            columnValues(columnCount) = rValue
            columnCount = columnCount + 1
        Next
    Next

And this is the code I have which writes to a textfile

这是我写到文本文件的代码

sFNText = sMakeFolder & "\" & rID.Value & ".txt"
Set oTxt = oFS.OpenTextFile(sFNText, 2, True)

For i = 0 To UBound(columnTitles)
     oTxt.Write columnTitles(i) & ": " & columnValues(i) & vbNewLine
Next i

oTxt.Close

I have experimented with changing the format of opentextfile and also using AscW and ChrW to convert to and from ansi but have had no joy. Please could anyone shed any light on my problem or perhaps suggest an easier method?

我尝试过修改opentextfile的格式,也尝试过使用AscW和ChrW转换到ansi和from ansi,但是没有任何乐趣。请大家给我讲讲我的问题,或者提出一个更简单的方法。

EDIT: In particular I am trying to read in Greek symbols (pie, omega etc.) and write them back out to a textfile. I have used the

编辑:特别是我正在尝试阅读希腊符号(派、欧米加等),并把它们写回一个文本文件。我已经使用了

StrConv(Cells(1, 1), vbUnicode)

method that was detailed in a similar post (see comments) and have got that example working. It seems now a problem with writing this out to a textfile. nixda's example seems to work great in isolation when using his Print command, however when I try and use

方法,该方法在类似的文章中详细介绍(请参阅注释),并使该示例生效。现在,把它写到文本文件中似乎是个问题。nixda的示例在使用Print命令时看起来非常独立,但是当我尝试使用它时

otxt.Write

to write my stored variable to a textfile it writes out garbage - as opposed to the print method which produces the correct result. Looking at the debugger both variables are stored identically (print method + write), so I believe it is now down to the output method (otxt.Write) which is converting the stored variable into garbage. I have tried using the -1 & -2 options for OpenTextFile - both producing garbage results.

要将存储的变量写入一个文本文件,它会写出垃圾——而不是生成正确结果的打印方法。查看调试器,这两个变量都是相同存储的(打印方法+写入),所以我认为现在应该是输出方法(otx . write),它将存储的变量转换为垃圾。我尝试过使用-1和-2选项来选择OpenTextFile——它们都产生垃圾结果。

3 个解决方案

#1


1  

I have the following sheet:

我有以下表格:

阅读VBA中的国际/特殊字符

and the following code:

和下面的代码:

Sub writeUnicodeText()
 Dim arr_Strings() As String
 i = 0
 For Each oCell In ActiveSheet.Range("A1:A4")
  ReDim Preserve arr_Strings(i)
  arr_Strings(i) = oCell.Value
  i = i + 1
 Next

 Set oFS = CreateObject("Scripting.Filesystemobject")
 Set oTxt = oFS.OpenTextFile("C:\users\axel\documents\test.txt", 2, True, -1)
 For i = 0 To UBound(arr_Strings)
  oTxt.Write arr_Strings(i) & vbNewLine
 Next i
 oTxt.Close
End Sub

This produces the following file:

这将产生以下文件:

阅读VBA中的国际/特殊字符

#2


0  

This is the code I use to write to a text. I've tried many methods and this has worked the best.

这是我用来写文本的代码。我尝试过很多方法,而且效果最好。

Sub ProcessX()
   FName1 = "Location of File"
   txtStrngX = OpenTextFileToString2(FName1)
end sub

Public Function OpenTextFileToString2(ByVal strFile As String) As String

 Dim hFile As Long
 hFile = FreeFile
 Open strFile For Input As #hFile
 OpenTextFileToString2 = Input$(LOF(hFile), hFile)
 Close #hFile

End Function

As for reading in from rows just be sure to set your variable to a string when compiling and any method should work fine.

至于从行中读取,只要确保在编译时将变量设置为字符串,任何方法都应该正常工作。

#3


0  

sorry. That's reading from a text. Here is writing.

对不起。这是从文本中读取的。这是写作。

Public Function RecordsetToText(rs As Object, Optional FullPath _
    As String, Optional ValueDelimiter As String = "  ") As Boolean

 'PURPOSE: EXPORTS DATA FROM AN ADO RECORDSET TO A TEXT FILE


 'PARAMETERS:


 'RS: Recordset to Export. Open the recordset before

 'passing it to this function


 'FullPath (Optional): FullPath of text file.

 'if not specified, the function uses app.path +

 'rs.txt


 'ValueDelmiter (Optional): String to delimiter

 'values within a row.  If not specified, an tab

 'is used


 'RETURNS: True if successful, false if an error occurs


 'COMMENTS: Rows are delimited by a carriage return

 Dim sFullPath As String

 Dim sDelimiter As String

 Dim iFileNum As Integer

 Dim lFieldCount As Long

 Dim lCtr As Long

 Dim oField As ADODB.Field


 On Error GoTo ErrorHandler:



 If RecordSetReady(rs) = False Then Exit Function



 sDelimiter = ValueDelimiter


 If FullPath = "" Then

     sFullPath = App.Path

     If Right(sFullPath, 1) <> "\" Then sFullPath = _

        sFullPath & "\"


     sFullPath = sFullPath & "rs.txt"

 Else

     sFullPath = FullPath

 End If


 iFileNum = FreeFile


 Open sFullPath For Output As #iFileNum


 With rs

 lFieldCount = .Fields.Count - 1


 On Error Resume Next

 .MoveFirst

 On Error GoTo ErrorHandler


 For lCtr = 0 To lFieldCount

    Set oField = .Fields(lCtr)

     If lCtr < lFieldCount Then

         Print #iFileNum, oField.Name & sDelimiter;

    Else

        Print #iFileNum, oField.Name

    End If

 Next


 Do While Not .EOF

    For lCtr = 0 To lFieldCount

    Set oField = .Fields(lCtr)

      If lCtr < lFieldCount Then

          Print #iFileNum, oField.Value & sDelimiter;

     Else

          Print #iFileNum, oField.Value

       End If

  Next

 .MoveNext

 Loop


 End With


 RecordsetToText = True


 ErrorHandler:

  On Error Resume Next

  Close #iFileNum


 End Function

#1


1  

I have the following sheet:

我有以下表格:

阅读VBA中的国际/特殊字符

and the following code:

和下面的代码:

Sub writeUnicodeText()
 Dim arr_Strings() As String
 i = 0
 For Each oCell In ActiveSheet.Range("A1:A4")
  ReDim Preserve arr_Strings(i)
  arr_Strings(i) = oCell.Value
  i = i + 1
 Next

 Set oFS = CreateObject("Scripting.Filesystemobject")
 Set oTxt = oFS.OpenTextFile("C:\users\axel\documents\test.txt", 2, True, -1)
 For i = 0 To UBound(arr_Strings)
  oTxt.Write arr_Strings(i) & vbNewLine
 Next i
 oTxt.Close
End Sub

This produces the following file:

这将产生以下文件:

阅读VBA中的国际/特殊字符

#2


0  

This is the code I use to write to a text. I've tried many methods and this has worked the best.

这是我用来写文本的代码。我尝试过很多方法,而且效果最好。

Sub ProcessX()
   FName1 = "Location of File"
   txtStrngX = OpenTextFileToString2(FName1)
end sub

Public Function OpenTextFileToString2(ByVal strFile As String) As String

 Dim hFile As Long
 hFile = FreeFile
 Open strFile For Input As #hFile
 OpenTextFileToString2 = Input$(LOF(hFile), hFile)
 Close #hFile

End Function

As for reading in from rows just be sure to set your variable to a string when compiling and any method should work fine.

至于从行中读取,只要确保在编译时将变量设置为字符串,任何方法都应该正常工作。

#3


0  

sorry. That's reading from a text. Here is writing.

对不起。这是从文本中读取的。这是写作。

Public Function RecordsetToText(rs As Object, Optional FullPath _
    As String, Optional ValueDelimiter As String = "  ") As Boolean

 'PURPOSE: EXPORTS DATA FROM AN ADO RECORDSET TO A TEXT FILE


 'PARAMETERS:


 'RS: Recordset to Export. Open the recordset before

 'passing it to this function


 'FullPath (Optional): FullPath of text file.

 'if not specified, the function uses app.path +

 'rs.txt


 'ValueDelmiter (Optional): String to delimiter

 'values within a row.  If not specified, an tab

 'is used


 'RETURNS: True if successful, false if an error occurs


 'COMMENTS: Rows are delimited by a carriage return

 Dim sFullPath As String

 Dim sDelimiter As String

 Dim iFileNum As Integer

 Dim lFieldCount As Long

 Dim lCtr As Long

 Dim oField As ADODB.Field


 On Error GoTo ErrorHandler:



 If RecordSetReady(rs) = False Then Exit Function



 sDelimiter = ValueDelimiter


 If FullPath = "" Then

     sFullPath = App.Path

     If Right(sFullPath, 1) <> "\" Then sFullPath = _

        sFullPath & "\"


     sFullPath = sFullPath & "rs.txt"

 Else

     sFullPath = FullPath

 End If


 iFileNum = FreeFile


 Open sFullPath For Output As #iFileNum


 With rs

 lFieldCount = .Fields.Count - 1


 On Error Resume Next

 .MoveFirst

 On Error GoTo ErrorHandler


 For lCtr = 0 To lFieldCount

    Set oField = .Fields(lCtr)

     If lCtr < lFieldCount Then

         Print #iFileNum, oField.Name & sDelimiter;

    Else

        Print #iFileNum, oField.Name

    End If

 Next


 Do While Not .EOF

    For lCtr = 0 To lFieldCount

    Set oField = .Fields(lCtr)

      If lCtr < lFieldCount Then

          Print #iFileNum, oField.Value & sDelimiter;

     Else

          Print #iFileNum, oField.Value

       End If

  Next

 .MoveNext

 Loop


 End With


 RecordsetToText = True


 ErrorHandler:

  On Error Resume Next

  Close #iFileNum


 End Function