Kiều Mạnh
I don't program, I beat code into submission!!!
- Tham gia
- 9/6/12
- Bài viết
- 5,538
- Được thích
- 4,132
- Giới tính
- Nam
Mình có viết một code sau cho Ứng dụng của mình sử dụng VBA điều kiển WinRaR nén và giải nén file ...
Giải nén tốt nhưng sẻ lỗi với Folder là khoãng trắng hay Folder là Tiếng việt có dấu ...
VD: D:\Kieu Manh\
Loay hay tìm cách xử lý hoài chưa được Úp lên nhờ các Bạn trợ Giúp ... Xin Cảm ơn
Giải nén tốt nhưng sẻ lỗi với Folder là khoãng trắng hay Folder là Tiếng việt có dấu ...
VD: D:\Kieu Manh\
Loay hay tìm cách xử lý hoài chưa được Úp lên nhờ các Bạn trợ Giúp ... Xin Cảm ơn
Mã:
Private Function UnRaR(ByVal FileRaR As String) As Variant
Dim Fso As Object, rarApp As String, Chk As Boolean
Dim Folder_Path, RaR As String
Set Fso = CreateObject("Scripting.FileSystemObject")
Folder_Path = Fso.GetFile(FileRaR).ParentFolder & "\"
RaR = Fso.GetExtensionName(FileRaR)
''// OK 1
''rarApp = CreateObject("Shell.Application").Namespace(&H26&).Self.path & "\WinRaR\WinRaR.exe"
''// OK 2 Su dung File cho RaR.exe DOS
rarApp = CreateObject("Shell.Application").Namespace(&H26&).Self.path & "\WinRaR\UnRaR.exe"
If Fso.FileExists(rarApp) Then Chk = True
If Fso.FileExists(FileRaR) Then
If Chk Then Shell rarApp & Space(1) & "X" & Space(1) & FileRaR & Space(1) & Folder_Path, vbHide
End If
Set Fso = Nothing
End Function
Private Sub Main()
Dim vFile
vFile = Application.GetOpenFilename("All Files, *.rar")
If TypeName(vFile) = "String" Then UnRaR vFile
End Sub
Lần chỉnh sửa cuối: