Reputation: 133
Is there a quick way to convert multiple files which are tab delimited, (each) into xls format ? Any MATLAB/VBA script will be great !
Thanks a lot !
Upvotes: 0
Views: 4174
Reputation: 360
First make a text file list of the files you want to open. I use an MS-DOS batch file containing the following code:
:: MSDOS batch file
:: creates a text file listing of all files in the current directory
@ECHO OFF
dir /b > filelist.txt
EXIT
Delete the directories and other nonsense from the text file, as desired.
Add a new module to your excel document. Insert the following
Function GetTextDirect(ByVal sFile As String) As String
'used to get the file list of imports
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetTextDirect = ts.readall
ts.Close
'Set fso = Nothing
End Function
Sub get_files()
'MsgBox ("Have you updated the file list? Create one by saving the following to a text file, then renaming it ""filelist generator.bat""" & _
Chr(10) & Chr(10) & _
":: - MS-DOS batch file" & Chr(10) & _
":: - creates a text file listing of all files in the current directory" & Chr(10) & _
"@ECHO OFF " & Chr(10) & _
"dir /b > filelist.txt" & Chr(10) & _
"EXIT")
'prompt user for the filelist
MsgBox ("Please select the file list at the following dialog box.")
Application.FileDialog(msoFileDialogOpen).InitialFileName = ThisWorkbook.Path & "\"
Application.FileDialog(msoFileDialogOpen).Show
filelist = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
'parse the directory and file name from filelist
For character_place = Len(filelist) To 1 Step -1
'Find the last ocurrence of "\" in the string
If InStr(Mid(filelist, character_place, 1), "\") Then Exit For
Next character_place
filelist_name = Right(filelist, Len(filelist) - character_place)
filelist_dir = Left(filelist, Len(filelist) - Len(filelist_name))
'identifying the name of the current workbook
workfile_name = ThisWorkbook.Name
'import directory
import_dir = filelist_dir
'locating the directory of the import file list
importlist = filelist_dir & filelist_name
'reading the import list
'calling the GetTextDirect function
'ensuring importlist is not empty
If Dir(importlist) <> "" Then
importlist_string = GetTextDirect(importlist)
Else
importlist_string = ""
End If
'initialize
workstring = importlist_string
delim = Chr(13) & Chr(10)
delim_POS = InStr(workstring, delim)
Dim selected_ARRAY() As String
ReDim selected_ARRAY(1 To 1, 1 To 3)
'selected_ARRAY(i, 1) = file directory
'selected_ARRAY(i, 2) = file name
'selected_ARRAY(i, 3) = distinguishing tab name
selected_ARRAY(1, 1) = "nothing_yet"
selected_ARRAY(1, 2) = "nothing_yet"
selected_ARRAY(1, 3) = "nothing_yet"
'parse workstring into discrete file names
Do While delim_POS > 0
'filename is the string to the left of the next delimiter
'reduce workstring accordingly
selected_filename = Trim(Left(workstring, delim_POS - 1))
workstring = Mid(workstring, Len(selected_filename) + Len(delim) + 1, Len(workstring) - Len(selected_filename))
'add selected_filename to selected_ARRAY
If selected_ARRAY(1, 1) = "nothing_yet" Then
selected_ARRAY(1, 1) = import_dir
selected_ARRAY(1, 2) = selected_filename
Else:
'add to the array, while preserving existing values
'create temporary copy of the array
tempArray = selected_ARRAY
arraysize = UBound(selected_ARRAY, 1)
ReDim selected_ARRAY(1 To arraysize + 1, 1 To 3)
'then reinsert values from tempArray
For m = 1 To arraysize
For n = 1 To UBound(selected_ARRAY, 2)
selected_ARRAY(m, n) = tempArray(m, n)
Next n
Next m
Set tempArray = Nothing
'read the new value(s) into the new upper bound of the array
selected_ARRAY(UBound(selected_ARRAY), 1) = import_dir
selected_ARRAY(UBound(selected_ARRAY), 2) = selected_filename
End If
'reinitializing
delim_POS = InStr(workstring, delim)
Loop
If selected_ARRAY(1, 1) = "nothing_yet" Then
'ensuring selected_ARRAY has at least one record
selected_ARRAY(1, 1) = importlist_string
ElseIf (workstring <> "") And (workstring <> delim) Then
'capturing the last field in cases where the importlist_string does not end with delim
'i.e. does not end with with <CR><LF>
'adding the remaining text in workstring to the selected_ARRAY
'add to the array, while preserving existing values
'create temporary copy of the array
tempArray = selected_ARRAY
arraysize = UBound(selected_ARRAY, 1)
ReDim selected_ARRAY(1 To arraysize + 1, 1 To 3)
'then reinsert values from tempArray
For m = 1 To arraysize
For n = 1 To UBound(selected_ARRAY, 2)
selected_ARRAY(m, n) = tempArray(m, n)
Next n
Next m
Set tempArray = Nothing
'read the new value(s) into the new upper bound of the array
selected_ARRAY(UBound(selected_ARRAY), 1) = import_dir
selected_ARRAY(UBound(selected_ARRAY), 2) = workstring
End If
'initialize temp file variable
'allows html/csv/txt/ect. to be imported to xls, despite Excel 2010
Dim tempWb As Workbook
tempfile_name = "temp.xls"
fulltempfile_name = import_dir & tempfile_name
'determine distinguishing tab name for each file in selected_ARRAY
For i = 1 To UBound(selected_ARRAY, 1)
'identified by interpreting the file name
selected_filename = selected_ARRAY(i, 2)
'identify the length of the file extension
For character_place = Len(selected_filename) To 1 Step -1
'Find the last ocurrence of "." in the string
If InStr(Mid(selected_filename, character_place, 1), ".") Then Exit For
Next
File_Ext = Right(selected_filename, Len(selected_filename) - character_place + 1)
File_Ext_len = Len(File_Ext)
'identify the new name for the imported tab
'tab names are limited to 31 characters long
If Len(Left(selected_filename, Len(selected_filename) - File_Ext_len)) > 31 Then
'prevents tab name of greater than 31 characters
'also prevents any file extension artifacts in the tab name
'i.e. theverybigfilenamethatgoeson.html becomes ...
' 1234567890123456789012345678901234
' theverybigfilenamethatgoeson instead of ...
' theverybigfilenamethatgoeson.ht
tabname = Left(Left(selected_filename, Len(selected_filename) - File_Ext_len), 31)
Else
tabname = Left(selected_filename, Len(selected_filename) - File_Ext_len)
End If
'record value to array
selected_ARRAY(i, 3) = tabname
Next i
'import files
For i = 1 To UBound(selected_ARRAY, 1)
'open incoming html/csv/txt/ect. file
'add to working file
selected_filename = selected_ARRAY(i, 2)
Workbooks.Open Filename:=selected_ARRAY(i, 1) & selected_filename
'Copy the ActiveSheet to tempWB
ActiveSheet.Copy
Set tempWb = ActiveWorkbook
'preventing saveas alerts
Application.DisplayAlerts = False
'use the 2000-2003 format xlWorkbookNormal to save as xls
tempWb.SaveAs fulltempfile_name, FileFormat:=-4143, CreateBackup:=False
tempWb.Close SaveChanges:=False
'restarting saveas alerts
Application.DisplayAlerts = False
'releasing resources
Set tempWb = Nothing
'close the import file
Windows(selected_filename).Activate
Application.CutCopyMode = False
ActiveWindow.Close SaveChanges:=False
'open the temporary file, i.e. xls friendly version of the html/csv/txt/ect. file
Workbooks.Open fulltempfile_name
ActiveSheet.Copy Before:=Workbooks(workfile_name).Sheets(1)
ActiveSheet.Move after:=Worksheets(Worksheets.Count)
'close the temp file
Windows(tempfile_name).Activate
ActiveWindow.Close
'rename tab
ActiveSheet.Name = selected_ARRAY(i, 3)
Next i
'signal the macro is complete
Sheets(1).Select
MsgBox ("Process complete.")
End Sub
Upvotes: 1