Private Const SEE_MASK_NOCLOSEPROCESS As Long = &H40
Private Const SW_HIDE As Long = 0
Private Const INFINITE As Long = &HFFFFFFFF
Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
' fields
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Private Declare Function CreateDirectory Lib "kernel32.dll" Alias "CreateDirectoryA" (ByVal lpPathName As String, ByVal lpSecurityAttributes As Long) As Long
Private Declare Function ShellExecuteEx Lib "shell32.dll" (ByRef lpExecInfo As SHELLEXECUTEINFO) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Function RunAndStop(ByVal filename As String, ByVal Params As String, ByVal StartDir As String) As Boolean
Dim sei As SHELLEXECUTEINFO
With sei
.cbSize = Len(sei)
.fMask = SEE_MASK_NOCLOSEPROCESS
.hwnd = Application.hwnd
.lpVerb = "open"
.lpFile = filename
.lpParameters = Params
.lpDirectory = StartDir
.nShow = SW_HIDE
End With
RunAndStop = ShellExecuteEx(sei)
If RunAndStop Then ' nêìu kiìch hoaòt filename thaÌnh công thiÌ ...
' ðõòi cho tõìi tâòn khi Process kêìt thuìc
WaitForSingleObject sei.hProcess, INFINITE
' giaÒi phoìng handle cuÒa Process
CloseHandle sei.hProcess
End If
End Function
Sub test()
PrepareAndRun "E:\XoaStyles\VdXoaStyles.xlsx"
End Sub
Sub PrepareAndRun(ByVal excelFile As String, Optional ByVal RARExe = "winrar.exe")
Dim Params As String, text As String, filename As String, StartDir As String, ext As String
Dim fso As Object, ts As Object, start As Long, end_ As Long
'Dim shortName As String, size As Long
' shortName = String(256, Chr(0))
' size = GetShortPathName(excelFile, shortName, 256)
' excelFile = Left(shortName, size)
start = InStrRev(excelFile, "\")
filename = Mid(excelFile, start + 1)
ext = LCase(Mid(filename, InStrRev(filename, ".")))
'ext = LCase(Mid(filename, Len(filename) - 4))
If ext <> ".xlsm" And ext <> ".xlsx" And ext <> ".zip" Then Exit Sub ' ne;e(u không laE( tân(p tin XLSM, XLSX thiE( ke;e(t thue(c
' thý mun(c ba(e(t ?âE(u laE( thý muc coe( chýe(a XLSM, XLSX
StartDir = Mid(excelFile, 1, start)
Set fso = CreateObject("Scripting.FileSystemObject")
' cae(c thông sôe( - Params - cho WinRAR - o"N( ?ây tôi bung luôn týE( tân(p tin XLSM.
' chiN( bung styles.xml vaE(o cuE(ng thý mun(c vo"e(i tân(p tin XLSM, XLSX
Params = "x -apxl " & """" & excelFile & """" & " xl\styles.xml"
' kie(ch hoan(t WinRAR ?e;N( bung styles.xml vaE(o cuE(ng thý mun(c vo"e(i tân(p tin XLSM, XLSX
If RunAndStop(RARExe, Params, StartDir) Then ' ne;e(u bung thaE(nh công thiE( ...
' mo"N( tân(p tin styles.xml vaE( ?on(c toaE(n bôn( nôn(i dung
Set ts = fso.OpenTextFile(StartDir & "styles.xml")
text = ts.ReadAll
ts.Close
' xoe(a tân(p tin styles.xml
fso.DeleteFile StartDir & "styles.xml", True
' tiE(m <cellStyle name= vaE( <cellStyle name="Normal" ?e;N( lýo"n(c boN(
start = InStr(1, text, "<cellStyle name=")
end_ = InStrRev(text, "<cellStyle name=""Normal""")
' nôn(i dung ?aT, lýo"n(c boN( týE( <cellStyle name= to"e(i trýo"e(c <cellStyle name="Normal"
text = Left(text, start - 1) & Mid(text, end_)
' tan(o tân(p tin styles.xml mo"e(i
Set ts = fso.CreateTextFile(StartDir & "styles.xml")
' ghi nôn(i dung mo"e(i vaE(o styles.xml
ts.Write text
Set ts = Nothing
' cae(c thông sôe( - Params - cho WinRAR ?e;N( the;m tân(p tin styles.xml vaE(o XLSM, XLSX
' - seT, thay the;e( styles.xml cuT,
Params = "a -apxl " & """" & excelFile & """" & " styles.xml"
' thay the;e( styles.xml cuT, ba(E(ng mo"e(i
If RunAndStop(RARExe, Params, StartDir) Then ' ne;e(u the;m thaE(nh công thiE( ...
' xoe(a tân(p tin styles.xml
fso.DeleteFile StartDir & "styles.xml", True
' mo"N( tân(p tin XLSM, XLSX
' Workbooks.Open StartDir & "\" & filename
End If
End If
Set fso = Nothing
End Sub
