I have one folder with multiple text files that I add one text file to every day. All text files are in the same format and are pipe delimited.
Is it possible to create code for excel that will automatically import the data from the multiple text files into one worksheet?
I found some code that would import all the text files from the folder, but only if I changed it all to comma delimited first. Also, I could not get it to update if I added files to the folder.
Any help would be greatly appreciated!
A good way to handle files in general is the 'FileSystemObject'. To make this available in VBA you need to add a reference to it:
(select the Tools\References menu. In the References dialog, select 'Microsoft Scripting Runtime')
The following code example will read all files in a folder, reads their content one line at a time, split each line into | separated bits, and writes theses bits to the active sheet starting at cell A1, one row per line.
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:\YourDirectory\")
' 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
the sub is deliberately simplified to remain clear (i hope) and will need work to be made robust (eg add error handling)
Sounds like it'd be easiser to run a script to cycle thru all the files in the directory, create a new file composed of all the files' contents as new lines, and save that as a csv. something like:
import os
basedir='c://your_root_dir'
dest_csv="<path to wherever you want to save final csv>.csv"
dest_list=[]
for root, subs, files in os.walk(basedir):
for f in files:
thisfile=open(basedir+f)
contents=thisfile.readlines()
dest_list.append(contents)
#all that would create a list containing the contents of all the files in the directory
#now we'll write it as a csv
f_csv=open(dest_csv,'w')
for i in range(len(dest_list)):
f_csv.write(dest_list[i])
f_csv.close()
You could save a script like that somewhere and run it each day, then open the resulting csv in excel. This assumes that you want to get the data from each file in a particular directory, and that all the files you need are in one directory.
You can use Schema.ini ( http://msdn.microsoft.com/en-us/library/ms709353(VS.85).aspx ), Jet driver and Union query, with any luck.
Related
I have two folders filled with similarly named excel files but in different templates. One of the templates (Newer) is blank, while the old template contains all the data.
The patterns between template A and template B are consistent - I know which cell in A goes to which cell in B, but I'm not sure how to create the macro in VBA to effectively process all of the files in one go.
I've so far created two File system objects, one per folder - but I'm not sure how to get it to pull up the identical file from the other folder to start the cloning process.
To avoid excel having issues opening files of the same name, the newer templates have a 3 character suffix at the end.
Any advice would be greatly appreciated!
Set picker = Application.FileDialog(msoFileDialogFolderPicker)
picker.Show
Set fldrs = picker.SelectedItems
fpath1 = fldrs(1)
Set picker = Application.FileDialog(msoFileDialogFolderPicker)
picker.Show
Set fldrs = picker.SelectedItems
fpath2 = fldrs(1)
Dim fso1 As Object
Dim vfolder1 As Object
Dim fso2 As Object
Dim vfolder2 As Object
Set fso1 = CreateObject("Scripting.FileSystemObject")
Set vfolder1 = fso1.GetFolder(fpath1)
Set fso2 = CreateObject("scripting.filesystemobject")
Set vfolder2 = fso2.GetFolder(fpath2)
For Each vfile In vfolder1.Files
Assuming that the file names always start the same ("the newer templates have a 3 character suffix at the end"), you can just strip the path and the extension from the file names with GetBaseName and compare them to see if the target file name starts with the source file name:
With New Scripting.FileSystemObject
Dim source As Folder, target As Folder
Set source = .GetFolder(fpath1)
Set target = .GetFolder(fpath2)
Dim item As File, fileName As String
For Each item In source.Files
'Get the filename without path or extension.
fileName = .GetBaseName(item)
Dim searched As File
For Each searched In target
'Does the file start with fileName?
If InStr(1, .GetBaseName(item), fileName) = 1 Then
'Files match, do your thing here.
End If
Next
Next
End With
Note that this is early bound. If you're insistant on not adding a reference to Microsoft Scripting Runtime (there's almost never a reason not to), just change the early bound variables to Object and replace the New Scripting.FileSystemObject with CreateObject.
I have this VBA code to count all values that are not zero in all excel files saved in a folder and print out the result in the worbook containing the macro. the problem I am having is that it opens the same file (the first one) over and over instead of moving to the next file.
Sub RealCount()
Dim file As String
Dim row As Integer
Dim wb As Workbook
row = 2
file = Dir("\\Daglig rapport\KPI Marknadskommunikation\FEB\*.xl??")
Do While file <> ""
Set wb = Workbooks.Open("\\Daglig rapport\KPI Marknadskommunikation\FEB\*.xl??")
Call ZeroCount
file = Dir("\\Daglig rapport\KPI Marknadskommunikation\FEB\*.xl??")
Loop
End Sub
Here's some suggestions to get it working:
Use a path variable to keep the folder location and make the code easier to read
Fix the Workbooks.Open so the parameter should be the actual file path (I'm kind of surprised Excel's Workbook.Open would actually work with wildcards characters like * or ?)
Check that ZeroCount doesn't call any Dir functions. If you do, then Excel may very well reset your ability to call Dir to correctly get the next file in your loop. If you find that this is happening and you must absolutely call Dir inside of this loop, then you could loop through all the Dir values first and store them into an array. Then make another loop that goes through that array which calls ZeroCount (or any code that needs to use Dir within it)
Here's an example of the first two points taken care of:
Sub RealCount()
Dim path as String
Dim file As String
Dim row As Integer
Dim wb As Workbook
path = "\\Daglig rapport\KPI Marknadskommunikation\FEB\"
row = 2
file = Dir(path & "*.xl??")
Do While file <> ""
Set wb = Workbooks.Open(path & file)
Call ZeroCount
row = row + 1 ' I assume you want to increment row each time as well maybe?
file = Dir()
Loop
End Sub
For some more examples of using VBA's Dir - see here: http://www.exceltrick.com/formulas_macros/vba-dir-function/
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.
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
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