I have the following files coming from a data logger.
As such they're save under weird extension. Which force me to manually convert to CSV & delimit column A by space.
I searched high & low for a code to loop through all files in a folder and convert to csv.
But all I could find were codes for
CSV to Txt
Txt to xml
xlsx to Txt
This is the closest I could find
Sub RenameFiles()
Dim StrFile As String, newName As String
Dim filePath As Variant
filePath = ActiveWorkbook.Path & "\"
StrFile = Dir(filePath & "*2")
Do While Len(StrFile) > 0
newName = Replace(StrFile, "csv", "csv")
Name filePath & StrFile As filePath & newName
StrFile = Dir
Loop
End Sub
The drive which I need to convert files from is shown below
C:\Users\PC04\Desktop\Rename
The extensions of my file name are in the image below
How can I convert all the file in that folder to csv & delimit "Column A" by "space"
Update
Code for me to delimit Column A, done with macro recording.
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Extension name shown below
Related
i am importing multiple text files in excel using the Macro given at this site
it is working but say for example u have data as 0010 it is changing it to 10 i tried to modify the code by adding
Destination:=Range("A1").NumberFormatLocal = "#" in the script but it is giving error
texttocoloums method of range class failed
here is the original code
Sub CombineTextFiles()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim wkbTemp As Workbook
Dim sDelimiter As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
sDelimiter = "|"
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, Title:="Text Files to Open")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "No Files were selected"
GoTo ExitHandler
End If
x = 1
Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
wkbTemp.Sheets(1).Copy
Set wkbAll = ActiveWorkbook
wkbTemp.Close (False)
wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:="|"
x = x + 1
While x <= UBound(FilesToOpen)
Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
With wkbAll
wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
.Worksheets(x).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:=sDelimiter
End With
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Set wkbTemp = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
Consider the following code. Run it , it works, does what you want. Might be a bit slower (if you don't have any blank lines in any of your notepad files you can remove If Len(lineData) > 0 Then & the end if. to speed it up again) but I think it always worth keeping those lines in, incase if you do have empty rows in any of your notepad files.
I was also going to refer you to Python which can convert .txt files to Excel, keep the formatting without any extra work, simpler. Pretty native of it to do so. So If you have python it might be better to use that to convert your notepad files to excel en-masse (they are short scripts no matter which method you use there), but in VBA I've refered to this for keeping the formatting & leading zeros, and this to create the structure to import my files.
Sub doIt6()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim InputTextFile As Variant
Dim SourceDataFolder As String, OutputDataFolder As String
SourceDataFolder = "C:\Users\User\Documents\Source_Data2 - Copy"
OutputDataFolder = "C:\Users\User\Documents\Output_Data - Copy"
'Loop through each text file in source folder
InputTextFile = Dir(SourceDataFolder & "\*.txt")
While InputTextFile <> ""
Workbooks.OpenText FileName:=SourceDataFolder & "\" & InputTextFile, DataType:=xlDelimited, Tab:=True
Dim myFileName As Variant
Dim myFileNames As Variant
Dim wb As Workbook
'myFileNames = Application.GetOpenFilename( _
' filefilter:="Excel Files,*.xl*;*.xm*", _
' title:="Select Excel File to Open", _
' MultiSelect:=True)
myFileNames = Application.GetOpenFilename _
(FileFilter:="Text Files (*.txt), *.txt", _
MultiSelect:=True, title:="Text Files to Open")
If Not IsArray(myFileNames) Then Exit Sub
For Each myFileName In myFileNames
Set wb = Workbooks.Open(myFileName, False, False)
'StandaloneReportEdit()'Sub to very thoroughly edit reports
Dim fn As Integer
Dim MyData As String
Dim lineData As String, strData() As String, myFile As String
Dim i As Long, rng As Range
'Workbooks.OpenText Filename:=SourceDataFolder & "\" & InputTextFile, DataType:=xlDelimited, Tab:=True
Set rng = Range("A1")
' Lets not rely on Magic Numbers
fn = FreeFile
Open myFileName For Input As #fn
i = 1
Do While Not EOF(fn)
Line Input #fn, lineData
If Len(lineData) > 0 Then
strData = Split(lineData, "|")
rng.Cells(i, 1).Resize(1, UBound(strData) + 1) = strData
End If
i = i + 1
Loop
Close #fn
ActiveWorkbook.SaveAs FileName:=OutputDataFolder & "\" & Replace(ActiveWorkbook.Name, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
InputTextFile = Dir
Next
'Save each output file in output folder / maybe put this inside the loop
'ActiveWorkbook.SaveAs FileName:=OutputDataFolder & "\" & Replace(ActiveWorkbook.Name, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'ActiveWorkbook.Close
'InputTextFile = Dir
Wend
End Sub
*note: I am at work, (day job). have lost many urls I was referring to (they are in chrome history but with no time to check on any others, & I must get on with my work) to do this, but can I re-edit this post and dig them up for you tonight if you need.
Does this answer your question ?
You could also import with Python. You could do this : (put your directory name containing all your the text files in mypath between the ' ''s)
Your files (csv's or .txt files) are read into dataframes, significantly as dtype='object' , which is the KEY here to preserving their formatting fully and keeping leading 000's in ALL txt source files when using the method.
I know there are 10000 other ways to do it much more elegantly (such as here and elsewhere) but I'm super happy I did it like this using Python as well.
from os import walk
import pandas as pd
from pathlib import Path
mypath=r'C:\Users\user\Documents\Data_Souce4\New Folder (2)'
f = []
df=[]
for (dirpath, dirnames, filenames) in walk(mypath):
f.extend(filenames)
#print(f)
#print(f[2])
for f in f:
ab=print(mypath+"\\"+f) #you an remove this - was just for me to see whats going on
str_path = mypath+"\\"+f
path=Path(str_path)
print(path)
df = pd.read_csv(path, dtype=('object'), sep=r'\\t')
df.to_excel(mypath + "\\" + f + '.xls', index=True, header=True)
break
I am trying to create an excel workbook that will automate a reconciliation process and I came across an issue that I can't overcome.
The initial input file is a CSV file that is comma delimited. The problem is that some of the entries have extra comma so when I do text to columns some of the cells have incorrect content. The next cell after first column has text in it so I am trying to find a way to use it as delimiter. Here are how entries look:
First row: a, b, c, d (always delimited with commas hence separate part in code)
Second row (in 90% of cases): a, b, c, d
Second row (in 10% of cases): a1, a2, b, c, d
B in the above line is a text and has quotes so looks like this "b".
Is there any way to adjust text to column to make it work properly?
Here is the code I have put together so far:
Sub ExampleSplit1()
Range("A1").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False, _
OtherChar:="-"
Range(Range("A2"), Range("A2").End(xlDown)).TextToColumns _
Destination:=Range("A2"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False, _
OtherChar:="-"
End Sub
I want the final result to look as follows:
Post suggested by #Frank Ball had solution that worked for me. Below is the code
Sub CSV_Import()
Dim ws As Worksheet, strFile As String
Set ws = ActiveWorkbook.Sheets("Sheet1") 'set to current worksheet name
strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select text file...")
With ws.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=ws.Range("A1"))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.Refresh
End With
End Sub
I am currently using VBA to generate an automated letter for me. Using the below:
Sub CreatePDF()
Dim wSheet As Worksheet
Dim vFile As Variant
Dim sFile As String
Set wSheet = ActiveSheet
sFile = Replace(Replace(wSheet.Name, " ", ""), ".", "_") _
& "_" _
& Format(Now(), "yyyymmdd\_hhmm") _
& ".pdf"
sFile = ThisWorkbook.Path & "\" & sFile
vFile = Application.GetSaveAsFilename _
(InitialFileName:=sFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If vFile <> "False" Then
wSheet.Range("P1:Y336").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=vFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
End If
End Sub
Wondering if there is a way to make the generated file name of the PDF to correspond to specific cell inputs (in the sheet, they are pulled in by vlookup). Ideally, have the file be: C7_C8.pdf
not sure if you mean the cell address, or what's inside the cell.
But i just hardcode the "sFile" to a specific cell in my worksheet :
sFile = Workbooks("blabla.xlsb").Sheets("Sheet1").Range("AE14")
into the below, notice the "" &
vFile = Application.GetSaveAsFilename _
(InitialFileName:="" & sFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
so whatever cell AE14 contains it will be passed as the PDF filename in the Save As prompt. hope it helps!
I have below program to batch convert text to excel (xlsx)
Sub LoopAllFiles()
Dim sPath As String, sDir As String
sPath = "C:\Users\DNA\Desktop\Test Convert\"
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sDir = Dir$(sPath & "*.txt", vbNormal)
Do Until Len(sDir) = 0
Workbooks.Open (sPath & sDir)
With ActiveWorkbook
.SaveAs Filename:=Left(.FullName, InStrRev(.FullName, ".")) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close
End With
sDir = Dir$
Loop
End Sub
However, I have problem to convert text to columns using pipe delimiter. I have developed some syntax as per below but I am not sure how to combine it with the converter scripts.
Selection.TextToColumns DataType:=xlDelimited, _ TextQualifier:=xlTextQualifierNone, Other:=True, _
OtherChar:="|", FieldInfo:=xlTextFormat
May you all please help.
Thank you.
Try OpenText instead of Open, see here for the detailed reference.
Workbooks.OpenText filename:=sPath & sDir, dataType:=xlDelimited, tab:=True, Other:=True, OtherChar:="|"
Try with below
Sub LoopAllFiles()
Dim sPath As String, sDir As String
sPath = "C:\work\"
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
sDir = Dir$(sPath & "*.txt", vbNormal)
Do Until Len(sDir) = 0
Workbooks.Open (sPath & sDir)
With ActiveWorkbook
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
.SaveAs Filename:=Left(.FullName, InStrRev(.FullName, ".")) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close
End With
sDir = Dir$
Loop
End Sub
I am trying to open all csv (separator is semicolon) files in a directory and this is the code that I think should work:
Sub test()
Dim MyFile As String
Dim MyDir As String
MyDir = Application.ActiveWorkbook.Path
MyFile = Dir(MyDir & "\" & "*.csv")
'set current directoy
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Do While MyFile <> ""
Workbooks.Open (MyFile)
'Parse it using semicolon as delimiters
Range(Range("A1"), Range("A1").End(xlDown)).TextToColumns _
DataType:=xlDelimited, _
ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False '
'next file in directory
MyFile = Dir()
Loop
End Sub
But strangely, it also uses comma as a separator as well. I can see that if I debug the TextToColumns line.
So for a csv file like
test;test,test
I would expect an output of
test test,test
But I actually get
test test
Why? Is there something wrong with my Excel settings?
Thanks!
The problem is with this line
Workbooks.Open (MyFile)
The moment you open the file in Excel, it is opened in this format as it is a Comma Delimited File
And then when the .TextToColumns code runs it replaces Column B data with the "test" which is after ; in Column A.
Try this
Let's say your csv file looks like this
Now try this code. Once you understand how it works, simply adapt this in your code. I have commented the code so that you will not have a problem understanding it.
Sub Sample()
Dim wb As Workbook, ws As Worksheet
Dim MyData As String, strData() As String
Dim myFile As String
Dim lRow As Long
'~~> Replace this with your actual file
myFile = "C:\Users\Siddharth\Desktop\test.csv"
'~~> open text file in memory and read it in one go
Open myFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
'~~> Add a new workbook
Set wb = Workbooks.Add
'~~> Work with the 1st sheet
Set ws = wb.Sheets(1)
With ws
'~~> Copy the array to worksheet
.Range("A1").Resize(UBound(strData), 1).Value = strData
'~~> get the last row of the data
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Use text To columns now
.Range("A1:A" & lRow).TextToColumns DataType:=xlDelimited, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False '
End With
End Sub
And this is what you get
EDIT: The other option that you have is to rename the csv file and then open it as suggested in Open csv file delimited by pipe character “|” or not common delimiter