How to export CSV file encoded with "Unicode" - excel

Currently i using VBA code to export range data to a CSV file:
Sub Fct_Export_CSV_Migration() Dim Value As String Dim size As Integer
Value = ThisWorkbook.Path & "\Export_Migration" & Sheets(1).range("B20").Value & ".csv" chemincsv = Value
Worksheets("Correspondance Nv Arborescence").Select Dim Plage As Object, oL As Object, oC As Object, Tmp As String, Sep$ Sep = ";" size = Worksheets("Correspondance Nv Arborescence").range("B" & Rows.Count).End(xlUp).Row Set Plage = ActiveSheet.range("A1:B" & size)
Open chemincsv For Output As #1 For Each oL In Plage.Rows
Tmp = ""
For Each oC In oL.Cells
Tmp = Tmp & CStr(oC.Text) & Sep
Next
'take one less than length of the string number of characters from left, that would eliminate the trailing semicolon
Tmp = Left(Tmp, Len(Tmp) - 1)
Print #1, Tmp Next Close
MsgBox "OK! Export to " & Value End Sub
Now, i would like to export CSV encoded with "Unicode". I think i need to use VBA function like SaveAs( xlUnicodeText ) but how to use that ?
Thx

Unicode CSVs are not one of the file formats supported by Excel, out of the box. This means we cannot use the SaveAs method. The good news we can work around this restriction, using VBA.
My approach uses the file system object. This incredibly handy object is great for interacting with the file system. Before you can use it you will need to add a reference:
From the VBA IDE click Tools.
Click References...
Select Windows Script Host Object Model from the list.
Press OK.
The code:
' Saves the active sheet as a Unicode CSV.
Sub SaveAsUnicodeCSV()
Dim fso As FileSystemObject ' Provides access to the file system.
Dim ts As TextStream ' Writes to your text file.
Dim r As Range ' Used to loop over all used rows.
Dim c As Range ' Used to loop over all used columns.
' Use the file system object to write to the file system.
' WARNING: This code will overwrite any existing file with the same name.
Set fso = New FileSystemObject
Set ts = fso.CreateTextFile("!!YOUR FILE PATH HERE.CSV!!", True, True)
' Read each used row.
For Each r In ActiveSheet.UsedRange.Rows
' Read each used column.
For Each c In r.Cells
' Write content to file.
ts.Write c.Value
If c.Column < r.Columns.Count Then ts.Write ","
Next
' Add a line break, between rows.
If r.Row < ActiveSheet.UsedRange.Count Then ts.Write vbCrLf
Next
' Close the file.
ts.Close
' Release object variables before they leave scope, to reclaim memory and avoid leaks.
Set ts = Nothing
Set fso = Nothing
End Sub
This code loops over each used row in the active worksheet. Within each row, it loops over every column in use. The contents of each cell is appended to your text file. At the end of each row, a line break is added.
To use; simply replace !!YOUR FILE PATH HERE.CSV!! with your file name.

Related

How to stop Excel from mangling a formula inserted by my VBA script

I have a VBA script in an Excel workbook that gathers results from all the workbooks in a particular folder.
Private Sub Workbook_Open()
Dim path As String
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim i As Integer
Dim data As Object
Set data = Worksheets("RawData")
path = data.Range("A1").Value
i = 3
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
data.Rows("2:" & data.Rows.Count).ClearContents
For Each file In folder.Files
If Right(UCase(file.name), 5) = ".XLSX" And Left(file.name, 1) <> "~" Then
data.Cells(i, 2) = "='" + path + "\[" + file.name + "]Summary'!A1:J1"
i = i + 1
End If
Next file
End Sub
The idea is for each .xlsx file in a given folder, I add a reference to the results range in that file. For example, if there is a file Test1.xlsx in folder C:\Sheets, the VBA puts the following formula into some row on the sheet containing the script:
='C:\Sheets\[Test1.xlsx]Summary'!A1:J1
Excel then pulls values out of Test1 and puts them in the current workbook's RawData sheet.
This worked until today, when my formulas started ending up with # right after the = sign, like this:
=#'C:\Sheets\[Test1.xlsx]Summary'!A1:J1
This gives me a #VALUE?.
Excel helpfully gave me a message stating that it has just now started inserting # into formulas due to some syntax changes, but that it wouldn't affect calculations. I can't get this message to show up again, but that was the gist of it. Obviously it does affect calculations. If I manually remove the # from the formula, it works fine.
I have Office 365 and I guess I must have received an update recently that added this "feature" because all this used to work fine.
If I modify the VBA script to reference only a single cell, the # does not get inserted. But using a named range for the results (rather than A1:J1) still has the problem.
Anyone have any ideas for a workaround?
To avoid the # from being inserted, use the .Formula2 property of the range object.
This change has to do with the dynamic array feature of Excel O365
You could assign the formula to a variable and then remove the # from the string using the Right() function...
As the length of the string will be dynamic depending on the length of the file name, I've used the Len() function to get the full lenght of the string, then minus 2 from it to remove the = and #.
Note the = is concatenated with the Right() function when assigning the value to the cell.
Dim FormulaString as String
For Each file In folder.Files
If Right(UCase(file.name), 5) = ".XLSX" And Left(file.name, 1) <> "~" Then
FormulaString = "='" + path + "\[" + file.name + "]Summary'!A1:J1"
data.Cells(i, 2) = "=" & Right(FormulaString, Len(FormulaString) - 2)
i = i + 1
End If
Next file
Output is
='C:\Sheets\[Test1.xlsx]Summary'!A1:J1

Is it possible to create a path to Excelfiles with VBA?

I am building a report on Excel that has to be updated monthly. Therefore I get every month a new Excelfile with data that has to be summarized in the report.
The report consists of the calculations of the specific Excelfiles with the data for each month, for example the amount of male or female customers.
Is it possible to create a macro via VBA that creates a path to the new Excelfile so that I do not have to change the path to the file manually? In this case for example instead that I have to change the formula to '...non_activated-2019-03' by typing it in, Excel should do it automatically because there are over 60 of these calculations in which I would have to change the file.
=COUNTIFS('C:\Users\denni\Desktop\Reporting\Non Activated\[non_activated-2019-02.xlsx]non_activated-2019-02'!$M:$M;$B$9;'C:\Users\denni\Desktop\Reporting\Non Activated\[non_activated-2019-02.xlsx]non_activated-2019-02'!$B:$B;$C10)
Yes, it is possible and I do it myself when I need to create reports and log files. Just add the following in your filename String:
filename = "...non_activated-" & Year(Date) & "-" & Month(Date)
Month Number with 0
If you want the month number to start with 0, you can simply change the code like this:
Sub yourSub()
'...
filename = "...non_activated-" & Year(Date) & "-" & getMonthNumber(Date)
'...
End Sub
Function getMonthNumber(data As Date) As String
If Month(data) < 10 Then
getMonthNumber = "0" & Month(data)
Else
getMonthNumber = Month(data)
End If
End Function
Open your file
There're a lot of ways to open (and write on) your file. You can try this:
Open yourPath & yourFilename For Output As #1
Print #1, "Print somenthing on your file"
'Do your stuff
Close #1
Now you have your file saved on your path.
Notes
By using this method, every month it creates automatically a new file which you can easily find.
Just remember to check if the file exists, otherwise it can launch
an exception.
You could use a function like so in a cell, on a sheet, then reference the cell in formulas, then leave them alone.
For example =GetLatestImportFile("C:\workspace\dummy data\")
Function GetLatestImportFile(strPath As String, _
Optional strLookFor As String = "non-activated")
Dim f As Scripting.FileSystemObject
Dim fld As Scripting.Folder
Dim fl As Scripting.File
Dim dt As Date
Set f = New Scripting.FileSystemObject
Set fld = f.GetFolder(strPath)
For Each fl In fld.Files
If InStr(1, fl.Name, strLookFor) > 0 Then
If fl.DateCreated > dt Then
dt = fl.DateCreated
GetLatestImportFile = fl.Name
End If
End If
Next fl
set f=nothing
set fld=nothing
set fl=nothing
End Function
So for now this code is doing quite well and replaces the old reference with the new one!
Sub MySub()
Dim old as String
Dim new as String
Dim i as Integer
old = "activated-2019-01"
new = "activated-2019-02"
For i=4 to 160
Cells(i,"E").FormulaLocal = Replace(Cells(i,"F").FormulaLocal, old, new)
Next i
End Sub

How to extract specific words from text files into xls spreadsheet

I'm new in VBA. Before posting my question here,I have spent almost 3 days surfing Internet.
I have 300+ text files (text converted from PDF using OCR),from text file. I need to get all words that contain "alphabet" and "digits" (as example KT315A, KT-315-a, etc) along with source reference (txt file name).
What I need is
1.add "smart filter" that will copy only words that contains
"alphabets" and "digits"
paste copied data to column A
add reference file name to column B
I have found code below that can copy all data from text files into excel spreadsheet.
text files look like
"line from 252A-552A to ddddd, ,,, #,#,rrrr, 22 , ....kt3443 , fff,,,etc"
final result in xls should be
A | B
252A-552A | file1
kt3443 | file1
Option Explicit
Const sPath = "C:\outp\" 'remember end backslash
Const delim = "," 'comma delimited text file - EDIT
'Const delim = vbTab 'for TAB delimited text files
Sub ImportMultipleTextFiles()
Dim wb As Workbook
Dim sFile As String
Dim inputRow As Long
RefreshSheet
On Error Resume Next
sFile = Dir(sPath & "*.txt")
Do Until sFile = ""
inputRow = Sheets("Temp").Range("A" & Rows.Count).End(xlUp).Row + 1
'open the text file
'format=6 denotes a text file
Set wb = Workbooks.Open(Filename:=sPath & sFile, _
Format:=6, _
Delimiter:=delim)
'copy and paste
wb.Sheets(1).Range("A1").CurrentRegion.Copy _
Destination:=ThisWorkbook.Sheets("Temp").Range("A" & inputRow)
wb.Close SaveChanges:=False
'get next text file
sFile = Dir()
Loop
Set wb = Nothing
End Sub
Sub RefreshSheet()
'delete old sheet and add a new one
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
Worksheets.Add
ActiveSheet.Name = "Temp"
On Error GoTo 0
End Sub
thanks!
It's a little tough to tell exactly what constitutes a word from your example. It clearly can contain characters other than letters and numbers (eg the dash), but some of the items have dots preceding, so it cannot be defined as being delimited by a space.
I defined a "word" as a string that
Starts with a letter or digit and ends with a letter or digit
Contains both letters and digits
Might also contain any other non-space characters except a comma
To do this, I first replaced all the commas with spaces, and then applied an appropriate regular expression. However, this might accept undesired strings, so you might need to be more specific in defining exactly what is a word.
Also, instead of reading the entire file into an Excel workbook, by using the FileSystemObject we can process one line at a time, without reading 300 files into Excel. The base folder is set, as you did, by a constant in the VBA code.
But there are other ways to do this.
Be sure to set the references for early binding as noted in the code:
Option Explicit
'Set References to:
' Microsoft Scripting Runtime
' Microsoft VBscript Regular Expressions 5.5
Sub SearchMultipleTextFiles()
Dim FSO As FileSystemObject
Dim TS As TextStream, FO As Folder, FI As File, FIs As Files
Dim RE As RegExp, MC As MatchCollection, M As Match
Dim WS As Worksheet, RW As Long
Const sPath As String = "C:\Users\Ron\Desktop"
Set FSO = New FileSystemObject
Set FO = FSO.GetFolder(sPath)
Set WS = ActiveSheet
WS.Columns.Clear
Set RE = New RegExp
With RE
.Global = True
.Pattern = "(?:\d(?=\S*[a-z])|[a-z](?=\S*\d))+\S*[a-z\d]"
.IgnoreCase = True
End With
For Each FI In FO.Files
If FI.Name Like "*.txt" Then
Set TS = FI.OpenAsTextStream(ForReading)
Do Until TS.AtEndOfStream
'Change .ReadLine to .ReadAll *might* make this run faster
' but would need to be tested.
Set MC = RE.Execute(Replace(TS.ReadLine, ",", " "))
If MC.Count > 0 Then
For Each M In MC
RW = RW + 1
WS.Cells(RW, 1) = M
WS.Cells(RW, 2) = FI.Name
Next M
End If
Loop
End If
Next FI
End Sub

Importing multiple text files to Excel based on specific characters in the data, and adding additional data when importing

I've found an answer to import lines of data from numerous text files into an Excel sheet (https://stackoverflow.com/a/4941605/1892030 answered by Chris Neilsen). However I would like to also do the following:
There is garbage data before and after the useful data I want to import. The lines of data I want to import all start with an asterix (*).
The data is comma delimited and must be parsed that way when imported into Excel. This I could change by editing the parse code in the above answer.
At the end of each line that is imported, I want to add an additional item of data which is the name of the text file where the data was imported from (name of file only, without file extension).
The answer from Chris refered to above works real well so I would like to edit the code to allow for my additional requirements under points 1 and 3 above - but don't know how. For completeness I copy the code from the earlier answer below. Many thanks.
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("C:\#test")
' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)
' Loop thru all files in the folder
For Each file In folder.Files
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine
' Parse the line into comma delimited pieces
Items = Split(TextLine, ",")
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
' Move to next row
Set cl = cl.Offset(1, 0)
Loop
' Clean up
FileText.Close
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
I haven't done it all for you (I expect the file name will need tidying up to fit the format you want) but drop this code in and it will get you started...
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine
' Process lines which don't begin with Asterisk (*)
If Left(TextLine,1)<>"*" Then
' This crudely appends the filename as if it were a column in the source file
TextLine = TextLine + "," + file.Name
' Parse the line into comma delimited pieces
Items = Split(TextLine, ",")
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
' Move to next row
Set cl = cl.Offset(1, 0)
End If
Loop

Importing multiple text files to Excel

I have about 600 text files. Each file contains 2 columns and is space delimited. Is there any way I can import all of them to the same excel spreadsheet?
I saw a post about this and used the following script but that didn't work for me. It gived me User-defined type not defined
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
' Get a FileSystem object
Set fso = New FileSystemObject
' get the directory you want
Set folder = fso.GetFolder("D:\mypath\")
' set the starting point to write the data to
Set cl = ActiveSheet.Cells(1, 1)
' Loop thru all files in the folder
For Each file In folder.Files
' Open the file
Set FileText = file.OpenAsTextStream(ForReading)
' Read the file one line at a time
Do While Not FileText.AtEndOfStream
TextLine = FileText.ReadLine
' Parse the line into | delimited pieces
Items = Split(TextLine, "|")
' Put data on one row in active sheet
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
' Move to next row
Set cl = cl.Offset(1, 0)
Loop
' Clean up
FileText.Close
Next file
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
`
Thanks for the help!
Most likely you need to set a reference to the Windows Scripting Host Object Model.
To do this, from the Visual Basic Editor choose Tools/References, then scroll down to find "Windows Script Host Object Model". Tick this box then press OK. Now try to run your code again.
Additionally, I notice you mention that your data is split into two columns and space-delimited. You'll need to replace the delimiter on the following line:
Items = Split(TextLine, "|")
With this:
Items = Split(TextLine, " ")
Finally, you'd be slightly better off replacing this:
For i = 0 To UBound(Items)
cl.Offset(0, i).Value = Items(i)
Next
With this:
cl.Resize(1,UBound(Items)-LBound(Items)+1).value = Items

Resources