Saving £ as £

[crackod93]

i have a couple of macros (thanks to all in the forums who have helped) , which make text files from excel in a particular format, eg removes bad formatting like doubledouble quotes "" etc... and then tidy up unwanted spaces row by row.

>>>>>> What i also need to do is when these text files are created, I need to find any £ and turn them into a £ eg these need to be in UTF8 and ive no idea how to do this (bit of a novice)

here's the macros used:

Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long

Sub generateOutput()

Application.Calculate

SetCurrentDirectory "C:\temp"


Dim outputFiles(0 To 3) As String
outputFiles(0) = "1.json"
outputFiles(1) = "2.json"
outputFiles(2) = "3.json"

For Each Value In outputFiles

ActiveWorkbook.Sheets(Value).Activate

Call TextNoModification(Value)
Call tidyup(Value)

Next

End Sub

************************************

Public Sub TextNoModification(ByVal filename As String)
Const DELIMITER As String = "," 'or "|", vbTab, etc.
Dim myRecord As Range
Dim myField As Range
Dim nFileNum As Long
Dim sOut As String

nFileNum = FreeFile
Open filename For Output As #nFileNum
For Each myRecord In Range("A1:A" & _
Range("A" & Rows.Count).End(xlUp).Row)
With myRecord
For Each myField In Range(.Cells(1), _
Cells(.Row, Columns.Count).End(xlToLeft))
sOut = sOut & DELIMITER & myField.Text
Next myField
Print #nFileNum, Mid(sOut, 2)
sOut = Empty
End With
Next myRecord
Close #nFileNum
End Sub


************************************


Sub tidyup(ByVal filename As String)

Const ForReading = 1
Const ForWriting = 2

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(filename, ForReading)

Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If Len(strLine) > 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If

Loop


objFile.Close

Set objFile = objFSO.OpenTextFile(filename, ForWriting)
objFile.Write strNewContents
objFile.Close

End Sub

 

[CharlesChuckieCharles]

the Replace function should work

strLine = Trim(strLine)

becomes

strLine = Trim(Replace(strLine, "£", "£", 1))

 

[mole999]

I thought it was substitute

SUBSTITUTE - Excel

 

[crackod93]

the Replace function should work

strLine = Trim(strLine)

becomes

strLine = Trim(Replace(strLine, "£", "£", 1))

this works perfectly - thank you!!!!