I have the following encrypted text in cell A1:
ԓԗՃխՓ՛ՐեՐ՞՚ըՖՑ՟խՑՙՔը՟՝ՇխՑ
I am trying to write this in a text file but the text shows as question marks characters ????????????????? in the text file.
Here is my code:
textFilePath = ThisWorkbook.Path & "\customfile.txt"
FF = VBA.FreeFile
Open textFilePath For Output As #FF
Print #FF, CStr(Sheet1.Cells(1,1).Value)
Close #FF
FYI: If I manually copy and paste the value of cell A1 in notepad, the text shows fine.
You cannot write like a normal text... You need to write like UTF-8:
Dim fsT As Object
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 'Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" 'Specify charset For the source text data.
fsT.Open 'Open the stream And write binary data To the object
fsT.WriteText Sheet1.Cells(1, 1).Value
fsT.SaveToFile "e:\0\customfile.txt", 2 'Save binary data To disk
taken from:
Save text file UTF-8 encoded with VBA
Related
I have a vba macro with that adds BOM to UTF-8 csv - it's needed for succesfully opening in Excel.
But the problem is, that when at the end of the line there is CrLf mark - excel makes new line below that line.
What I need is to remove all CrLf marks (no Cr or Lf should be added instead). It should help because only Cr will exist in csv. CrLf exists only in fault lines.
Can you help please with my source code? What formula should I add to replace in source csv to save target csv with BOM without any CrLf?
Dim fsT, tFileToOpen, tFileToSave As String
tFileToOpen = "C:\source_NO_BOM.csv"
tFileToSave = "C:\target_WITH_BOM.csv"
tFileToOpenPath = tFileToOpen
tFileToSavePath = tFileToSave
Set fsT = CreateObject("ADODB.Stream"): 'Create Stream object
fsT.Type = 2: 'Specify stream type – we want To save text/string data.
fsT.Charset = "utf-8": 'Specify charset For the source text data.
fsT.Open: 'Open the stream
fsT.LoadFromFile tFileToOpenPath: 'And write the file to the object stream
fsT.SaveToFile tFileToSavePath, 2: 'Save the data to the named path
You can create another stream object, change the content you broke into it, and export it.
Dim fsT, tFileToOpen, tFileToSave As String
Dim s As String, Newfst As Object
tFileToOpen = "C:\source_NO_BOM.csv"
tFileToSave = "C:\target_WITH_BOM.csv"
tFileToOpenPath = tFileToOpen
tFileToSavePath = tFileToSave
Set fsT = CreateObject("ADODB.Stream"): 'Create Stream object
With fsT
.Type = 2: 'Specify stream type ? we want To save text/string data.
.Charset = "utf-8": 'Specify charset For the source text data.
.Open: 'Open the stream
.LoadFromFile tFileToOpenPath: 'And write the file to the object stream
s = .ReadText
s = Replace(s, vbCrLf, "")
End With
Set Newfst = CreateObject("ADODB.Stream")
With Newfst
.Type = 2
.Charset = "utf-8"
.Open
.WriteText s
.SaveToFile tFileToSave, 2
End With
Every time I use this code, for some reason, double quotation marks appear for cell's output from beginning to ending. Anyway how I can remove these quotation marks?
I tried using a basic VBA, where it copies data from a certain column and converts it to a txt file.
Dim s As String, FileName As String, FileNum As Integer
' Define full pathname of TXT file
FileName = ThisWorkbook.Path & "\2019.con"
' Copy range to the clipboard
Range("A2", Cells(Rows.Count, "A").End(xlUp)).Copy
' Copy column content to the 's' variable via clipboard
With New DataObject
.GetFromClipboard
s = .GetText
End With
Application.CutCopyMode = False
' Write s to TXT file
FileNum = FreeFile
If Len(Dir(FileName)) > 0 Then Kill FileName
Open FileName For Binary Access Write As FileNum
Put FileNum, , s
Close FileNum
Actual Result:
"CONT=10"
"."
"."
"."
Desired Result:
CONT=10
.
.
.
You should use Print not Write if you don't want the quote marks
I have a subroutine that reads text files and extracts certain data from them. Here is an example:
NamePrefix = "Example"
OutputPath = "C:\Example"
DbSize = 65536
LstStr = ""
Dim Success() As Boolean
Dim Value() As Double
ReDim Success(1 to DbSize)
ReDim Value(1 to DbSize)
For ID = 1 to DbSize
'Read string
FileName = NamePrefix & Format(ID,"000000") & ".lst"
FilePath = OutputPath & "\" & FileName
Open FilePath For Input As 1
LstStr = Input(LOF(1),1)
Close 1
'Extract data
If InStr(1, LstStr, "SUCCESS") <> 0 Then Success(i) = True Else Success(i) = False
Pos1 = InStr(1, LstStr, "TH 1 value: ") 'Position varies for each file
Value(i) = Val(Mid(LstStr, Pos1 + 13, 10)) 'Value in scientific notation
Next ID
The use of InStr to locate strings by position works perfectly when there are just alphabets, numbers and symbols. However, sometimes the files contain Chinese characters and the Input function returns an empty string "" to LstStr. I tried to use some other suggested methods but in vain (e.g. Extract text from a text file with Chinese characters using vba). How should I read files with Chinese characters successfully, in a way that I do not need to modify other parts of the code which extract data by position? Thanks!
This would be an alternative way to read the string. Make sure that the .Charset is set to the charset of the file you want to read.
To use ADOBD you will need to add the reference Microsoft ActiveX Data Objects 6.1 Library (Version can be different) in VBA Menu › Extras › References
Dim adoStream As ADODB.Stream
Set adoStream = New ADODB.Stream
adoStream.Charset = "UTF-8" 'set the correct charset
adoStream.Open
adoStream.LoadFromFile FilePath
LstStr = adoStream.ReadText
adoStream.Close
Set adoStream = Nothing
I need to export data from Excel to a comma delimited file. I am using a button that runs a macro that creates the text file in a location I specify and exports values.
But, I want to copy this Excel with the same macro, and add different values. When I run the macro in the copied Excel file I want the same text delimited file to add these values under the previous set of values, not overwrite the values from the first Excel file.
How is this possible? I want to use the same text file each time.
Append using following routine:
Sub writeCSV(ByVal thisRange As Range, ByVal filePath As String, _
Optional ByVal fileAppend As Boolean = False)
Dim cLoop As Long, rLoop As Long
Dim ff As Long, strRow As String
ff = FreeFile
If fileAppend Then
Open filePath For Append As #ff
Else
Open filePath For Output As #ff
End If
For rLoop = 1 To thisRange.Rows.Count
strRow = ""
For cLoop = 1 To thisRange.Columns.Count
If cLoop > 1 Then strRow = strRow & ","
strRow = strRow & thisRange.Cells(rLoop, cLoop).Value
Next 'cLoop
Print #ff, strRow
Next 'rLoop
Close #ff
End Sub
Example usage
writeCSV sheet1, "c:\test.txt", true
It is easy to do it by using a StreamWriter. The AppendText function of the FileInfo class returns one that is configured for appending text to an existing file.
I write my example as pseudo code, as I don't know how you are retrieving the information from Excel. The File handling part, however, is complete:
Dim file As New FileInfo("C:\myOuputFile.csv")
Using writer = file.AppendText()
While isRowAvailable
writer.WriteLine("Write next row")
End While
End Using
The Using statement automatically closes the file at the end.
I have hundreds of csv files with filenames in the following format: yyyymmdd_something.csv, e.g. 20131213_something.csv ... i.e., an underscore separates the date from the rest of the filename.
Each of has the following fields:
Make, Model, metric 1, metric 2, etc.
I would like to:
1) Insert the date from the file name into (preferably first) column, like so:
Date, Make, Model, metric 1, metric 2, etc.
But really it can be any column because once in Excel, it is a simple matter to re-arrange it. The date should be added as mm/dd/yyyy as it is what Excel understands.
2) After inserting the date, I would like to merge all the csv into 1 big csv file.
I'm using a Win7 machine so a dos batch file would probably be the simplest way to run it for me but if I had to, I can install perl or something to do this. Any help would be deeply appreciated. There was a thread that talks about inserting the whole file name but I really need only the date part added.
Hi this can be done by vbscript, the code is below:
Create a VBS file (notepad can do it, just paste following code and save file as .vbs)
You can drop 20-50 files (yyyymmdd_something.csv) as the same time to the icon of this vbs file and it will process as you wish :)
Please create Summary.csv file first and update its full path to pSumaryCSV = "......\Summary.csv"
'USAGE:
'CREATE A VBSCRIPT FILE .VBS WITH THIS CONTENT
'CREATE SUMMARY CSV FILE AND UPDATE ITS FULL PATH IN pSumaryCSV
'DRAG AND DROP YOUR ORIGINAL CSV FILE TO THIS VBS FILE ICON, IT CAN PROCESS MULTIPLE FILE (BUT DON'T PUT TOO MANY AS ONE)
'THIS CODE WILL CREATE A NEW CSV FILE <ORIGINAL FILE NAME>_DATE_ADDED.csv
'AND UPDATE Summary.csv file.
Set objArgs = WScript.Arguments
Set objFso = createobject("scripting.filesystemobject")
dim objOrgFile
dim arrStr ' an array to hold the text content
dim sLine ' holding text to write to new file
'Location of the summary file - Full path. If it is not exist then create it first.
'The summary one should have all column lable since following code will not add label to it.
pSumaryCSV = "......\Summary.csv"
'Open the summary file to append data
set aSummaryFile = objFso.OpenTextFile(pSumaryCSV, 8) '2=Open for writing 8 for appending
'Looping through all dropped file
For t = 0 to objArgs.Count - 1
' Input Path
inPath = objFso.GetFile(wscript.arguments.item(t))
inName = objFso.GetFileName(inPath)
' OutPut Path
outPath = replace(inPath, objFso.GetFileName(inPath), left(inName, InStrRev(objFso.GetFileName(inPath),".") - 1) & "_DATE_ADDED.csv")
' The original file
set objOrgFile = objFso.OpenTextFile(inPath)
'Now Creating the file can overwrite exiting file with same name
set aNewFile = objFso.CreateTextFile(outPath, True)
aNewFile.Close
'Open the new file (...._DATE_ADDED.csv) to appending data
set aNewFile = objFso.OpenTextFile(outPath, 8) '2=Open for writing 8 for appending
'=======================================================================
'Process first line, this firstline will not be added to SummaryCSV File
If Not objOrgFile.AtEndOfStream Then
arrStr = split(objOrgFile.ReadLine,",")
sLine = "Date," 'This will add Date label for
For i=lbound(arrStr) to ubound(arrStr)
sLine = sLine + arrStr(i) + ","
Next
'Writing first line to new file but not the summary one.
aNewFile.WriteLine left(sLine, len(sLine)-1) 'Get rid of that extra comma from the loop
end if
'=======================================================================
' Reading subsequent line and writing it to new file
Do Until objOrgFile.AtEndOfStream
arrStr = split(objOrgFile.ReadLine,",")
'Get the mm/dd/yyyy path from file name yyyymmdd
sLine = ""
sLine = sLine + Mid(inName,5,2) + "/" 'Get mm from file name
sLine = sLine + Mid(inName,7,2) + "/" 'Get dd from file name
sLine = sLine + Mid(inName,1,4) + "/" 'Get yyyy from file name
sLine = Sline + "," 'This will add a column
For i=lbound(arrStr) to ubound(arrStr)
sLine = sLine + arrStr(i) + ","
Next
'Writing data to new file
aNewFile.WriteLine left(sLine, len(sLine)-1) 'Get rid of that extra comma from the loop
'Writing data to summary file
aSummaryFile.WriteLine left(sLine, len(sLine)-1)
Loop
'Closing new file
aNewFile.Close
Next ' This is for next file
'Close Summary File
aSummaryFile.Close
set aSummaryFile=nothing
set aNewFile=nothing
set objFso = nothing
set objArgs = nothing