|
|
Public Sub 目錄下所有文件解壓(Source As String, Target As String, reutxt As String, man As String, dropmak As Integer) '(i)MyChar
Dim MyPath As String, MyName As String, retval As Long, mystr As String, N As Long, i As Long, MyChar1 As String, mendrop As Integer, N11 As Long
Dim a() As String, b() As String
Dim fdropmak As Integer
N11 = 100 '假定100個目錄
ReDim a(1 To N11)
N = 1
MyPath = Source ' 指定路徑。
MyName = Dir(MyPath, vbDirectory) ' 找尋第一項。'第一次用帶有通配符的參數(shù)'接下去不需要參數(shù)
Do While MyName <> "" ' 開始循環(huán)。
If MyName <> "." And MyName <> ".." Then ' 跳過當(dāng)前的目錄及上層目錄。
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then ' 使用位比較來確定 MyName 代表一目錄。
If N > N11 Then
N11 = UBound(a) + 100
ReDim Preserve a(1 To N11) '超過100個目錄，再擴展
End If
a(N) = MyName
N = N + 1
End If
End If
MyName = Dir ' 查找下一個目錄。
Loop
mendrop = 0
For i = 1 To N - 1
If Dir(Target, vbDirectory) = "" Then MkDir Target '創(chuàng)建目錄
If Dir(Target & a(i), vbDirectory) = "" Then MkDir Target & a(i) '創(chuàng)建目錄
mystr = "C:\Program Files\WinRAR\WinRAR.exe"
解壓 mystr, Source & a(i) & "\RNCCN-*.gz", Target & a(i), retval
'MsgBox Source & a(i) & "\*.gz" & "#" & Target & a(i)
Dim f As String
fdropmak = 0
f = Target & a(i) & "\" & Dir(Target & a(i) & "\RNCCN-*.xml")
' Sleep 50
TRACE f, MyChar1, a(i), dropmak, fdropmak '文件，結(jié)果，目錄，標記
If fdropmak = 1 Then
reutxt = reutxt & Chr(13) & man & MyChar1
mendrop = mendrop + 1
End If
Next i
If i > 1 And mendrop = 0 Then reutxt = reutxt & Chr(13) & man & MyChar1
If i = 1 Then reutxt = reutxt & Chr(13) & man & "無文件生成"
End Sub
|
|
QQ好友和群
QQ空間
騰訊微博
騰訊朋友
收藏
淘帖
頂
踩
