If WScript.Arguments.Count > 0 Then Filename = WScript.Arguments(0) 
Set a = CreateObject("Excel.Application") 
If Filename = "" Then 
Filename = a.GetOpenFilename("Excel Files (*.xls), *.xls") 
If VarType(Filename) = vbBoolean Then 
MsgBox "Excel2Txt用于将Excel文件的每个Sheet保存为一个文本文件。" & vbCr & vbLf & vbCr & vbLf & "用法: Excel2Txt filename.xls 或在对话框中打开Excel文件。" 
WScript.Quit 
End If 
End If 
Set w = a.Workbooks.Open(Filename) 
n = Replace(Replace(w.Name, ".xls", ""), ".XLS", "") 
a.DisplayAlerts = False 
For Each s In w.Sheets 
s.SaveAs w.Path & "\" & n & "_" & s.Name & ".txt", 20 
Next 
a.Quit 
复制代码

Set objExcel = CreateObject("Excel.Application") '建一个exel对象 
Set objWorkbook = objExcel.Workbooks.Open _ 
("E:\DOC\Hewl\领域模型.xls") '打开文件 
strToBeWrited = "-----------------------------------" & vbcrlf & _ 
"-- Generated by ScriptGenerator ---" & vbcrlf & _ 
"-----------------------------------" & vbcrlf & vbcrlf 
Count = objWorkbook.WorkSheets.Count '取sheet数量 
Set my = CreateObject("Excel.Sheet") '新建sheet对象 
For Each my In objWorkbook.WorkSheets '遍历sheet 
If my.Name = "目录" or my.Name = "SecondHandHouse" Then 
'do nothing 
Else 
'Wscript.Echo my.Name '获得sheet名字 
'Wscript.Echo my.Rows.Count 
'strToBeWrited = strToBeWrited & "create table " & my.Name & vbcrlf 
strToBeWrited = strToBeWrited & "/*==============================================================*/" & vbcrlf 
strToBeWrited = strToBeWrited & "/* Table: " & my.Name & " */" & vbcrlf 
strToBeWrited = strToBeWrited & "/*==============================================================*/" & vbcrlf 
strToBeWrited = strToBeWrited & "create table " & my.Name & " (" & vbcrlf 
rowNum = 3 
Do Until my.Cells(rowNum,1).Value = "" 
'Wscript.Echo "sAMAccountName: " & my.Cells(rowNum, 2).Value 
strToBeWrited = strToBeWrited & " " & my.Cells(rowNum,2).Value & " " & my.Cells(rowNum,3).Value & " not null" 
If not my.Cells(rowNum,9).Value = "" Then 
strToBeWrited = strToBeWrited & " default " & my.Cells(rowNum,9).Value 
End If 
strToBeWrited = strToBeWrited & "," & vbcrlf 
rowNum = rowNum + 1 
Loop 
strToBeWrited = strToBeWrited & " constraint PK_" & my.Name & " primary key (id)" & vbcrlf 
strToBeWrited = strToBeWrited & ")" & vbcrlf 
End If 
strToBeWrited = strToBeWrited & vbcrlf 
Next 
For Each my In objWorkbook.WorkSheets '遍历sheet 
If my.Name = "目录" or my.Name = "SecondHandHouse" Then 
'do nothing 
Else 
strToBeWrited = strToBeWrited & " constraint PK_" & my.Name & " primary key (id)" & vbcrlf 
strToBeWrited = strToBeWrited & ")" & vbcrlf 
End If 
strToBeWrited = strToBeWrited & vbcrlf 
Next 
'写文件 
set fs =createobject("scripting.filesystemobject") 
set f = fs.opentextfile("E:\DOC\Hewl\dbscript.sql",2, true) 
'Wscript.Echo strToBeWrited 
f.write strToBeWrited 
f.close 
Set f = nothing 
Set fs = nothing 
objExcel.Quit '结束退出 
复制代码

Dim Excel 
Set Excel = CreateObject("Excel.Application") 
'不显示提示信息,这样保存的时候就不会提示是否要覆盖原文件 
Excel.DisplayAlerts=FALSE 
'调用EXCEL文件的时候不显示 
Excel.visible=FALSE 
Excel.workbooks.open("D:\test.XLS") 
'将sheet1设置为活动sheet 
Excel.workbooks(1).activate 
'插入行,这条我找MSDN都没找到,最后乱试试出来的 
Excel.ActiveSheet.rows(1).insert 
Excel.ActiveSheet.Cells(1,1).Value = Date 
Excel.ActiveSheet.Cells(1,2).Value = "row1" 
Excel.ActiveSheet.Cells(1,3).Value = "comment1" 
Excel.ActiveSheet.rows(2).insert 
Excel.ActiveSheet.Cells(2,1).Value = Date 
Excel.ActiveSheet.Cells(2,4).Value = "row2" 
Excel.ActiveSheet.Cells(2,7).Value = "comment2" 
Excel.save 
Excel.quit 
Set Excel = Nothing 
Excel.ActiveSheet.rows(1).insert 
复制代码