將製表符分隔文件批量轉換爲xls

Question

是否有一種快速方法將製表符分隔的多個文件（每個）轉換爲xls格式？ 任何MATLAB/VBA腳本都會很棒！

非常感謝！

Answer 1

首先製作要打開的文件的文本文件列表。我用包含以下代碼的MS-DOS批處理文件：

:: MSDOS batch file 
:: creates a text file listing of all files in the current directory 
@ECHO OFF 
dir /b > filelist.txt 
EXIT 

刪除從文本文件的目錄和其他無義，如需要的話。

在excel文檔中添加一個新模塊。插入以下內容

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 ... 
     '  123456789
     '  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