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
Leo的備忘錄
2011年5月26日 星期四
合併同一資料夾下多個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
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
2011年3月23日 星期三
在Excel中利用ADO連接Oracle資料庫
Dim myCon As ADODB.Connection
Dim myRS As ADODB.Recordset
Dim conSTR As String '連線字串
Dim GetDataSQL As String 'SQL Statement
Dim myOracleServer As String '資料庫
Dim myUser As String '使用者
Dim myPassword As String '密碼
myOracleServer = "orcl"
myUser = "scott"
myPassword = "password"
'設定連線字串
conSTR = "Provider=MSDAORA.1" & _ '資料庫類型
";Data Source=" & myOracleServer & _ '資料庫名稱
";User ID=" & myUser & _ '使用者
";Password=" & myPassword '密碼
Set myCon = New ADODB.Connection '建立ADODB.Connection物件
Set myRS = New ADODB.Recordset '建立ADODB.Recordset物件
myCon.Open conSTR '開啟連線
With myRS
.ActiveConnection = myCon
.Source = GetDataSQL
.Open
End With
Range("B2").CopyFromRecordset myRS
Set myRS = Nothing
myCon.Close
Set myCon = Nothing
Dim myRS As ADODB.Recordset
Dim conSTR As String '連線字串
Dim GetDataSQL As String 'SQL Statement
Dim myOracleServer As String '資料庫
Dim myUser As String '使用者
Dim myPassword As String '密碼
myOracleServer = "orcl"
myUser = "scott"
myPassword = "password"
'設定連線字串
conSTR = "Provider=MSDAORA.1" & _ '資料庫類型
";Data Source=" & myOracleServer & _ '資料庫名稱
";User ID=" & myUser & _ '使用者
";Password=" & myPassword '密碼
Set myCon = New ADODB.Connection '建立ADODB.Connection物件
Set myRS = New ADODB.Recordset '建立ADODB.Recordset物件
myCon.Open conSTR '開啟連線
With myRS
.ActiveConnection = myCon
.Source = GetDataSQL
.Open
End With
Range("B2").CopyFromRecordset myRS
Set myRS = Nothing
myCon.Close
Set myCon = Nothing
2011年2月26日 星期六
取出當日日期之SQL語法
1.Oracle
Select trunc(sysdate) from dual
2.SQL Server
(1)先轉成Varchar再轉回Datetime
Case(Convert(VARCHAR, getdate(),101) as datetime)
(2)先轉成浮點數後取整數位,再轉回Datetime
Case(Floor(Cast(getdate() as float)) as datetime)
Select trunc(sysdate) from dual
2.SQL Server
(1)先轉成Varchar再轉回Datetime
Case(Convert(VARCHAR, getdate(),101) as datetime)
(2)先轉成浮點數後取整數位,再轉回Datetime
Case(Floor(Cast(getdate() as float)) as datetime)
訂閱:
文章 (Atom)