beyond compare解决特殊字符无法输出、多sheet页无法对比以及文件太大超出系统内存问题的Excel转txt脚本

beyond compare解决特殊字符无法输出、多sheet页无法对比以及文件太大超出系统内存问题的Excel转txt脚本

' XLS_to_CSV.vbs
'
' Converts an Excel workbook to a comma-separated text file.  Requires Microsoft Excel.
' Usage:
'  WScript XLS_to_CSV.vbs <input file> <output file>

Option Explicit

' MsoAutomationSecurity
Const msoAutomationSecurityForceDisable =
' OpenTextFile iomode
Const ForReading =
Const ForAppending =
Const TristateTrue = -
' XlFileFormat
Const xlCSV =  ' Comma-separated values
Const xlUnicodeText =
' XlSheetVisibility
Const xlSheetVisible = -

Dim App, AutoSec, Doc, FileSys, AppProtect
Set FileSys = CreateObject("Scripting.FileSystemObject")
If FileSys.FileExists(WScript.Arguments()) Then
    FileSys.DeleteFile WScript.Arguments()
End If
Set App = CreateObject("Excel.Application")
'Set AppProtect = CreateObject("Excel.Application")

On Error Resume Next

App.DisplayAlerts = False
AutoSec = App.AutomationSecurity
App.AutomationSecurity = msoAutomationSecurityForceDisable
Err.Clear

Dim I, J, SheetName, TgtFile, TmpFile, TmpFilenames(), Content
Set Doc = App.Workbooks.Open(WScript.Arguments(), False, True)
If Err =  Then
    I =
    For J =  To Doc.Sheets.Count
        If Doc.Sheets(J).Visible = xlSheetVisible Then
            I = I +
        End If
    Next
    ReDim TmpFilenames(I - )
    Set TgtFile = FileSys.OpenTextFile(WScript.Arguments(), ForAppending, True, TristateTrue)
    I =
    For J =  To Doc.Sheets.Count
        If Doc.Sheets(J).Visible = xlSheetVisible Then
            SheetName = Doc.Sheets(J).Name
            TgtFile.WriteLine """SHEET " & SheetName & """"
            Doc.Sheets(J).Activate
            TmpFilenames(I) = FileSys.GetSpecialFolder() & "\" & FileSys.GetTempName
            Doc.SaveAs TmpFilenames(I), xlUnicodeText
            Set TmpFile = FileSys.OpenTextFile(TmpFilenames(I), ForReading, False, TristateTrue)
            'Write 写整个文件的话，写失败会导致整个文件所有内容丢失，所以采用逐行方式。
            '也可以防止文件太大内存不足问题
            while not TmpFile.AtEndOfStream
                TgtFile.WriteLine TmpFile.ReadLine
            Wend
            'TgtFile.Write TmpFile.ReadAll
            TmpFile.Close
            If I <> UBound(TmpFilenames) Then
                TgtFile.WriteLine
            End If
            Doc.Sheets(J).Name = SheetName
            I = I +
        End If
    Next
    TgtFile.Close
    Doc.Close False
End If

App.AutomationSecurity = AutoSec
App.Quit
Set App = Nothing

For I =  To UBound(TmpFilenames)
    If FileSys.FileExists(TmpFilenames(I)) Then
        FileSys.DeleteFile TmpFilenames(I)
    End If
Next

WScript.Sleep()

'这步操作为了将关闭失败的窗口暴露置到前台交给用户手工关,应该会被上面的On Error Resume Next捕捉忽略
App.Visible = true

'If AppProtect.Workbooks.Count = 0 Then
'    '保护进程可不能随便退出，用户可能正在使用
'    AppProtect.Quit
'End If
'AppProtect.Visible = true
'Set AppProtect = Nothing

' XLS_to_CSV.vbs'' Converts an Excel workbook to a comma-separated text file.  Requires Microsoft Excel.' Usage:'  WScript XLS_to_CSV.vbs <input file> <output file>
Option Explicit
' MsoAutomationSecurityConst msoAutomationSecurityForceDisable = 3' OpenTextFile iomodeConst ForReading = 1Const ForAppending = 8Const TristateTrue = -1 ' XlFileFormatConst xlCSV = 6 ' Comma-separated valuesConst xlUnicodeText = 42' XlSheetVisibilityConst xlSheetVisible = -1
Dim App, AutoSec, Doc, FileSys, AppProtectSet FileSys = CreateObject("Scripting.FileSystemObject")If FileSys.FileExists(WScript.Arguments(1)) ThenFileSys.DeleteFile WScript.Arguments(1)End IfSet App = CreateObject("Excel.Application")'Set AppProtect = CreateObject("Excel.Application")
On Error Resume Next
App.DisplayAlerts = FalseAutoSec = App.AutomationSecurityApp.AutomationSecurity = msoAutomationSecurityForceDisableErr.Clear
Dim I, J, SheetName, TgtFile, TmpFile, TmpFilenames(), ContentSet Doc = App.Workbooks.Open(WScript.Arguments(0), False, True)If Err = 0 ThenI = 0For J = 1 To Doc.Sheets.CountIf Doc.Sheets(J).Visible = xlSheetVisible ThenI = I + 1End IfNextReDim TmpFilenames(I - 1)Set TgtFile = FileSys.OpenTextFile(WScript.Arguments(1), ForAppending, True, TristateTrue)I = 0For J = 1 To Doc.Sheets.CountIf Doc.Sheets(J).Visible = xlSheetVisible ThenSheetName = Doc.Sheets(J).NameTgtFile.WriteLine """SHEET " & SheetName & """"Doc.Sheets(J).ActivateTmpFilenames(I) = FileSys.GetSpecialFolder(2) & "\" & FileSys.GetTempNameDoc.SaveAs TmpFilenames(I), xlUnicodeTextSet TmpFile = FileSys.OpenTextFile(TmpFilenames(I), ForReading, False, TristateTrue)'Write 写整个文件的话，写失败会导致整个文件所有内容丢失，所以采用逐行方式。'也可以防止文件太大内存不足问题while not TmpFile.AtEndOfStream            TgtFile.WriteLine TmpFile.ReadLine            Wend    'TgtFile.Write TmpFile.ReadAllTmpFile.CloseIf I <> UBound(TmpFilenames) ThenTgtFile.WriteLineEnd IfDoc.Sheets(J).Name = SheetNameI = I + 1End IfNextTgtFile.CloseDoc.Close FalseEnd If
App.AutomationSecurity = AutoSecApp.QuitSet App = Nothing
For I = 0 To UBound(TmpFilenames)If FileSys.FileExists(TmpFilenames(I)) ThenFileSys.DeleteFile TmpFilenames(I)End IfNext
WScript.Sleep(1000)
'这步操作为了将关闭失败的窗口暴露置到前台交给用户手工关,应该会被上面的On Error Resume Next捕捉忽略App.Visible = true
'If AppProtect.Workbooks.Count = 0 Then'    '保护进程可不能随便退出，用户可能正在使用        '    AppProtect.Quit'End If'AppProtect.Visible = true'Set AppProtect = Nothing