回复 10# 523066680
已搞定。
我的方法是,先获取压缩文件的修改时间T1,然后运行7z.exe,如果没有更新文件操作,就把压缩文件的修改时间改回到T1。- '*************************************************************************************
- '使用 7-Zip 命令行压缩文件,若无文件更新,则压缩档的修改时间不会更新
- '*************************************************************************************
- Function CompressFolderBy7z(ByVal strSrcDir, ByVal strDesDir, Byval strPassword)
- Dim wso, fso, oExec, dtModifyDate, sApp7z, sMode, sInfo, sDesFile
- Dim objShell, objFolder, objItem
- Set wso = CreateObject("WScript.Shell")
- Set fso = CreateObject("Scripting.filesystemobject")
-
- '获取 7-Zip 命令行路径
- On Error Resume Next
- sApp7z = wso.ExpandenVironmentStrings(wso.RegRead("HKCU\SOFTWARE\7-Zip\Path"))
- On Error GoTo 0
- If fso.FileExists(sApp7z & "7za.exe") Then
- sApp7z = sApp7z & "7za.exe"
- ElseIf fso.FileExists(sApp7z & "7z.exe") Then
- sApp7z = sApp7z & "7z.exe"
- Else
- Msgbox "找不到 7za.exe 或 7z.exe,请安装 7-Zip 后使用本程序。", vbCritical, WScript.ScriptName
- WScript.Quit
- End If
-
- '设置备份文件夹位置(修正盘符与UNC标示)
- If fso.FolderExists(strSrcDir) = False Then Exit Function
- If Right(strDesDir, 1) = "\" Then strDesDir = Left(strDesDir, Len(strDesDir)-1)
- If InStr(strSrcDir, ":\") Then strDesDir = strDesDir & "\" & Split(strSrcDir, ":\")(0) & "\" & Split(strSrcDir, ":\")(1)
- If InStr(strSrcDir, "\\") Then strDesDir = strDesDir & "\" & Split(strSrcDir, "\\")(1)
- If Instr(strDesDir,"\") > 0 Then
- Dim arr : arr = Split(strDesDir,"\") : ReDim Preserve arr(UBound(arr)-1) : strDesDir = Join(arr,"\")
- End If
- If fso.FolderExists(strDesDir) = False Then wso.Run "cmd /u /c md """ & strDesDir & """", 0, True
-
- '设置目标文件(*.7z)位置
- sDesFile = strDesDir & "\" & (Split(strSrcDir,"\")(UBound(Split(strSrcDir,"\")))) & ".7z"
-
- '执行压缩操作,记录“修改时间”,取得执行结果
- If fso.FileExists(sDesFile) = False Then
- sMode = "a"
- Else
- sMode = "u"
- dtModifyDate = fso.GetFile(sDesFile).DateLastModified
- End If
- WScript.Echo Now() & " [" & UCase(sMode) & "] " & sDesFile
- If strPassword <> "" Then strPassword = "-p" & strPassword
- Set oExec = wso.Exec("""" & sApp7z & """ " & sMode & " " & strPassword & " -r- -ssw -t7z """ & _
- sDesFile & """ """ & strSrcDir & """")
- sInfo = oExec.StdOut.ReadAll
- 'Msgbox sInfo '调试-查看执行结果
-
- '无更新则还原修改时间
- If sMode = "u" And Instr(1, sInfo, "Items to compress: 0", vbTextCompare) > 0 Then
- Set objShell = CreateObject("Shell.Application")
- Set objFolder = objShell.NameSpace(fso.GetFile(sDesFile).ParentFolder.Path)
- For Each objItem In objFolder.Items
- If UCase(objItem.Path) = UCase(fso.GetFile(sDesFile).Path) Then
- sMode = "s" 'skip
- objItem.ModifyDate = dtModifyDate
- Exit For
- End If
- Next
- Set objShell = Nothing
- End If
-
- '返回结果
- If sMode = "s" Then
- WScript.Echo Now() & " ... [Skip]"
- Else
- WScript.Echo Now() & " ... [Ok]"
- End If
- CompressFolderBy7z = "[" & UCase(sMode) & "]" & sDesFile
- Set fso = Nothing
- Set wso = Nothing
-
- End Function
复制代码
|