Domanda

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 !

È stato utile?

Soluzione

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
Autorizzato sotto: CC-BY-SA insieme a attribuzione
Non affiliato a StackOverflow
scroll top