2

I read an Excel spreadsheet row by row and for each row create a textfile including information from the columns.

From time to time there is foreign text in some of the spreadsheet cells. In the debugger the foreign text appears as '?' question marks. It fails when trying to write these question marks to the text file.

This is a snippet of the code that reads the values 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

This is the code which writes to a text file

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.

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

StrConv(Cells(1, 1), vbUnicode)

method that was detailed in How can I create text files with special characters in their filenames and have got that example working. It seems now a problem with writing this to a textfile. nixda's example seems to work in isolation when using his Print command, however when I try

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.

Community
  • 1
  • 1
Garreth
  • 1,057
  • 2
  • 9
  • 24
  • VBA <> VB.NET and VB.NET doesnt have macros – Ňɏssa Pøngjǣrdenlarp Mar 25 '15 at 13:20
  • 1
    possible duplicate of [How can I create text files with special characters in their filenames](http://stackoverflow.com/questions/14261632/how-can-i-create-text-files-with-special-characters-in-their-filenames) – David Zemens Mar 25 '15 at 13:22
  • 1
    So with setting the format parameter to Unicode (-1) `Set oTxt = oFS.OpenTextFile(sFNText, 2, True, -1)` you had no success? What kind of "foreign text" is this? Can you give an example? – Axel Richter Mar 25 '15 at 14:07

3 Answers3

1

I have the following sheet:

enter image description here

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:

enter image description here

Axel Richter
  • 56,077
  • 6
  • 60
  • 87
  • This worked for me after cleaning down my code and starting again. I think potentially I had too many solutions jumbled up and complicating the issue. It appears as though there was no need for the strconv function. I think it's possible that the -1 flag on the opentextfile function fixed my issue. I am sure I tried this but with other solutions in place it may not have worked. Thanks! – Garreth Mar 25 '15 at 22:36
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.

jbay
  • 126
  • 9
  • You know that you should [edit] the answer (besides that code looks wrong. `Print` function never support Unicode) – user202729 Oct 05 '21 at 11:34
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
jbay
  • 126
  • 9