Option Explicit
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const SYNCHRONIZE = &H100000 '进程同步
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Const INFINITE = &HFFFFFFFF
Public Sub Main()
Dim objVSSDatabase As VSSDatabase
Dim objVSSProject As VSSItem
Dim strErrorDescription As String
Dim wzipexe As String ' winzip 执行文件的位置
Dim wcmd As String ' Shell 指令
Dim retval As Double
Dim strFileName As String
Dim arr() As String
Dim strPara() As String
Dim strSrcServer As String
Dim strSrcPath As String
Dim strSrcUser As String
Dim strSrcPwd As String
Dim strDstServer As String
Dim strDstPath As String
Dim strDstUser As String
Dim strDstPwd As String
On Error GoTo Error_Handler
' strPara = Split(Command, "|")
' strSrcServer = strPara(0)
' strSrcPath = strPara(1)
' strSrcUser = strPara(2)
' strSrcPwd = strPara(3)
' strDstServer = strPara(4)
' strDstPath = strPara(5)
' strDstUser = strPara(6)
' strDstPwd = strPara(7)
strSrcServer = "//Source/bo3vss$/srcsafe.ini"
strSrcPath = "$/BMS-BACH"
strSrcUser = "*******"
strSrcPwd = "*******"
strDstServer = "//Dest$/srcsafe.ini"
strDstPath = "$/BMS/Backup Files"
strDstUser = "*******"
strDstPwd = "*******"
Dim fs As FileSystemObject
Set fs = New FileSystemObject
Set objVSSDatabase = New VSSDatabase
objVSSDatabase.Open strSrcServer, strSrcUser, strSrcPwd
Set objVSSProject = objVSSDatabase.VSSItem(strSrcPath, False)
objVSSProject.Get Local:="D:/LocalTemp", iFlags:=VSSFLAG_TIMENOW + VSSFLAG_REPREPLACE + VSSFLAG_RECURSYES + VSSFLAG_FORCEDIRNO + VSSFLAG_EOLCRLF
Set objVSSDatabase = Nothing
'Delete
fs.DeleteFolder "D:/LocalTemp/S0(Requirment)", True
fs.DeleteFile "D:/LocalTemp/S1(Exteneral Spec)/Meeting Minutes/FIN_20060414(CEA,CEG,BTP,INV920).MP3", True
arr = Split(strSrcPath, "/")
strFileName = arr(UBound(arr)) & "-" & Format(Now, "yyyyMMdd") & ".zip"
wzipexe = "D:/program files/winzip/WINzip32" ' winzip 执行文件的位置
wcmd = wzipexe & " -a -r " & "D:/" & strFileName & " " & "D:/LocalTemp/*.*"
'retval = Shell(wcmd, 6)
OpenFileWait wcmd
Set objVSSDatabase = New VSSDatabase
objVSSDatabase.Open strDstServer, strDstUser, strDstPwd
Set objVSSProject = objVSSDatabase.VSSItem(strDstPath, False)
objVSSProject.Add "D:/" & strFileName
Set objVSSProject = Nothing
Set objVSSDatabase = Nothing
fs.DeleteFile "D:/" & strFileName, True
fs.DeleteFolder "D:/LocalTemp", True
' MsgBox "OK"
Exit Sub
Error_Handler:
Set objVSSProject = Nothing
Set objVSSDatabase = Nothing
strErrorDescription = "[(" & 1051 + vbObjectError & ")(" & App.Title & ")(cmdGet_Click)]" & Err.Description
MsgBox Err.Description
Screen.MousePointer = 0
End Sub
Private Sub OpenFileWait(tkFileName As String)
Dim wndID As Long
Dim wnd As Long
wndID = Shell(tkFileName, 6)
wnd = OpenProcess(SYNCHRONIZE, 0, wndID)
WaitForSingleObject wnd, INFINITE
CloseHandle wnd
End Sub