批量转换以制表符分隔的文件为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 ...
        '     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