📄 job1.vbs
字号:
Dim msFolder
Dim msBaseFolder
Dim msAccessEmpty
Dim msAccessFull
Dim msProject
Dim msFTPFile
Dim msFTPFileLog
Dim msToday
Dim msDTSServer
Dim msDTSUser
Dim msDTSPwd
Dim msDTSLog
Dim msDTSPkg
nMonth = month(date)
if Clng(nMonth) < 10 then nMonth = "0" & nMonth
msToday = year(date) & nMonth & day(date) & replace(FormatDateTime(now,4),":","")
msProject = "project1"
msBaseFolder = replace(ucase(WScript.ScriptFullName),ucase("\" & msProject & "\" & WScript.ScriptName),"")
msFolder = msBaseFolder & "\" & msProject
msAccessEmpty = "empty.mdb"
msAccessFull = msProject & msToday & ".mdb"
msFTPFile = msFolder & "\" & "Job1FTP.scr"
msFTPFileLog = msFolder & "\" & "Job1FTP.log"
msDTSLog = msFolder & "\" & "Job1DTS.htm"
' SQL Server connection settings and DTS Package name
msDTSServer = "(local)"
msDTSUser = "sa"
msDTSPwd = "mypassword"
msDTSPkg = msProject & "export"
Sub ProcessJob()
on error resume next
Const DTSSQLStgFlag_Default = 0
Const DTSStepExecResult_Failure = 1
Const ForWriting = 2
Dim oPkg
Dim oStep
Dim bStatus
Dim oFS
Dim oFile
' Remove files from the previous instances of this job
RemoveFile msFolder & "\files\" & msAccessEmpty
RemoveFile msFolder & "\files\" & msAccessFull
RemoveFile msFTPFile
RemoveFile msFTPFileLog
RemoveFile msDTSLog
' Copy the empty.mdb shell to our working folder
CopyFile msBaseFolder, msAccessEmpty,msFolder & "\files",msAccessEmpty
' Execute our DTS Package stored in SQL Server
Set oPkg = CreateObject("DTS.Package")
oPkg.LoadFromSQLServer msDTSServer,msDTSUser,msDTSPwd,DTSSQLStgFlag_Default,"","","",msDTSPkg
oPkg.Execute()
bStatus = True
' Write a log file displaying success or failure for each package step.
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFile = oFS.OpenTextFile(msDTSLog,ForWriting,True)
oFile.WriteLine "<html><body>"
oFile.WriteLine "Execution time: [" & Now() & "] "
For Each oStep In oPkg.Steps
oFile.WriteLine " Pkg Step " & oStep.Name & " "
If oStep.ExecutionResult = DTSStepExecResult_Failure Then
oFile.WriteLine " failed<br>"
bStatus = False
Else
oFile.WriteLine " succeeded<br>"
End If
oFile.WriteLine "Task """ & oPkg.Tasks(oStep.TaskName).Description & """<br>"
Next
If bStatus Then
oFile.WriteLine "Package " & oPkg.Name & " succeeded<br>"
Else
oFile.WriteLine "Package " & oPkg.Name & " failed<br>"
End If
Set oPkg = nothing
oFile.WriteLine "Done: [" & Now() & "] " & "<br></body></html>"
' Close the package log file
oFile.Close
Set oFile = nothing
Set oFS = nothing
' Rename our working empty.mdb to our desired filename
RenameFile msFolder & "\files",msAccessEmpty,msAccessFull
' FTP the file
FTPPutFile
End Sub
Sub FTPPutFile()
Dim oFS
Dim oFile
Dim oFileScript
Dim oStream
Dim oShell
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Const TristateUseDefault = -2
Const TristateTrue = -1
Const TristateFalse = 0
on error resume next
' Grab the general FTP login info
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFileScript = oFS.GetFile(msBaseFolder & "\" & "FTP.scr")
' Open the new empty FTP script for writing
Set oFile = oFS.OpenTextFile(msFTPFile,ForWriting,True)
' Read the general FTP login info line by line
Set oStream = oFileScript.OpenAsTextStream(ForReading, TristateUseDefault)
Do While Not oStream.AtEndOfStream
' Write general login info to our new FTP script
oFile.WriteLine oStream.ReadLine
Loop
' close the general login info file
oStream.Close
Set oStream = nothing
Set oFileScript = nothing
' write job specific commands to the FTP script
oFile.WriteLine "binary"
oFile.WriteLine "lcd " & msFolder & "\files"
oFile.WriteLine "cd " & msProject
oFile.WriteLine "put " & msAccessFull
oFile.Write "quit"
oFile.Close
Set oFile = Nothing
Set oFS = Nothing
' Execute the FTP script and append the results to the log file
Set oShell = CreateObject("WScript.Shell")
oShell.Run "%comspec% /c ftp.exe -i -s:" & msFTPFile & " >" & msFTPFileLog, 0, True
Set oShell = nothing
sErrFolder = msFolder & "\error.txt"
if err.number <> 0 then WriteFile sErrFolder, err.description
End Sub
Sub WriteFile(sFilePathAndName,sFileContents)
on error resume next
Const ForWriting=2
Set oFS = CreateObject("Scripting.FileSystemObject")
Set oFSFile = oFS.OpenTextFile(sFilePathAndName,ForWriting,True)
oFSFile.Write(sFileContents)
oFSFile.Close
Set oFSFile = Nothing
Set oFS = Nothing
End Sub
Sub RemoveFile(sFilePathAndName)
Set oFS = CreateObject("Scripting.FileSystemObject")
If oFS.FileExists(sFilePathAndName) = True Then
oFS.DeleteFile sFilePathAndName, True
end if
Set oFS = Nothing
End Sub
Sub CopyFile(sFileFromFolder,sFileFrom,sFileToFolder,sFileTo)
Set oFS = CreateObject("Scripting.FileSystemObject")
oFS.CopyFile sFileFromFolder & "\" & sFileFrom,sFileToFolder & "\"
Set oFS = Nothing
End Sub
Sub RenameFile(sFolder,sFileFrom,sFileTo)
Set oFS = CreateObject("Scripting.FileSystemObject")
oFS.MoveFile sFolder & "\" & sFileFrom,sFolder & "\" & sFileTo
Set oFS = Nothing
End Sub
ProcessJob
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -