匯入TXT檔到Excel(用位元數分隔欄位)

Option Explicit
Dim objShell    'Declare SHELL
Dim objFSO        'Declare FileSystemObject
Dim objXLApp    'Declare Excel Application
Dim newFileName    'Declare Destination File Name
Dim newWB        'Declare Destination Workbook
Dim    FileLists    'Declare Files in Script Directory
Dim objFile        'Declare File Object
Dim objXLBook    'Declare Workbook

Set objShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objXLApp = WScript.CreateObject("Excel.Application")

objXLApp.DisplayAlerts = False

Set FileLists = objFSO.GetFolder(objShell.CurrentDirectory).Files
For Each objFile in FileLists
    If(objFSO.GetExtensionName(objFile) ="txt") Then
    objXLApp.Workbooks.OpenText objFile, 950, 6, 2,,,,,,,,, _
        Array(Array(0, 1), Array(41, 1), Array(57, 9), Array(59, 1), Array(75, 1), Array(92, 9), Array(93, 1), _
        Array(109, 1), Array(125, 1), Array(141, 1), Array(157, 1))
    objXLApp.ActiveWorkbook.SaveAs(Left(objFile,Len(objFile)-3) & "xls")
    objXLApp.ActiveWorkbook.Close
    End If
Next

objXLApp.DisplayAlerts = True

objXLAPP.Quit
WScript.Quit

Set objXLBook = Nothing
set objFile = Nothing
set FileLists = Nothing
Set newWB = Nothing
set newfilename = Nothing
Set objXLApp = Nothing
Set objFSO = Nothing
Set objShell = Nothing

合併同一資料夾下多個Excel檔的VBScript

Option Explicit
Dim objShell    'Declare SHELL
Dim objFSO        'Declare FileSystemObject
Dim objXLApp    'Declare Excel Application
Dim newFileName    'Declare Destination File Name
Dim newWB        'Declare Destination Workbook
Dim    FileLists    'Declare Files in Script Directory
Dim objFile        'Declare File Object
Dim objXLBook    'Declare Workbook

Set objShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objXLApp = WScript.CreateObject("Excel.Application")
objXLApp.Visible = True

newfilename = InputBox("請輸入檔案名稱：")
newfilename = objShell.CurrentDirectory &"\"& newfilename
If (Right(newfilename, 3) <> "xls") Then
        newfilename = newfilename & ".xls"
End If

set newWB = objXLApp.Workbooks.add
newWB.SaveAs newfilename

Set FileLists = objFSO.GetFolder(objShell.CurrentDirectory).Files
For Each objFile in FileLists
    If(objFSO.GetExtensionName(objFile) ="csv" and objfile.name <> newWB.name) Then
        Set objXLBook = objXLApp.Workbooks.Open(objFSO.GetAbsolutePathName(objFile))
        objXLBook.Worksheets.Copy , newWB.Worksheets(newWB.Worksheets.Count)
        objXLBook.Close
    End If
Next
newWB.Worksheets(Array(1, 2, 3)).Delete
newWB.Save
newWB.Close
objXLAPP.Quit
WScript.Quit

Set objXLBook = Nothing
set objFile = Nothing
set FileLists = Nothing
Set newWB = Nothing
set newfilename = Nothing
Set objXLApp = Nothing
Set objFSO = Nothing
Set objShell = Nothing