làm Add-ins tự chạy xoá sheet XL4Poppy trong excel

Liên hệ QC

khanhvc2003

Thành viên mới
Tham gia
10/3/08
Bài viết
34
Được thích
6
Công ty mình đang bị con virus marco XL4Poppy, mình định viết code
bằng VBA của excel đưa vào add-ins để xoá Sheet XL4Poppy một cách tự động sau khi mở file lên.

Mình không biết là sao để thực hiện công việc này.

Mong được được trợ giúp.
 
Công ty mình đang bị con virus marco XL4Poppy, mình định viết code bằng VBA của excel đưa vào add-ins để xoá Sheet XL4Poppy một cách tự động sau khi mở file lên.

Mình không biết là sao để thực hiện công việc này.

Mong được được trợ giúp.

Lỡ như cái sheet Macro 4 ấy hổng phải tên là "XL4Poppy" thì sao?
Vậy nên phải duyệt qua các sheet, xét Type của nó ---> If Sheets(wksName).Type = 3 Then SheetType = "MacroSheet" ---> Gặp đúng thằng này thì XÓA
-------------
Đại khái thế thôi chứ nếu muốn đưa vào AddIn và hoạt động 1 cách tự động thì phải qua 1 công đoạn khá dài (đang mường tượng là phải cần đến Class đấy)
 
Lỡ như cái sheet Macro 4 ấy hổng phải tên là "XL4Poppy" thì sao?
Vậy nên phải duyệt qua các sheet, xét Type của nó ---> If Sheets(wksName).Type = 3 Then SheetType = "MacroSheet" ---> Gặp đúng thằng này thì XÓA
-------------
Đại khái thế thôi chứ nếu muốn đưa vào AddIn và hoạt động 1 cách tự động thì phải qua 1 công đoạn khá dài (đang mường tượng là phải cần đến Class đấy)

Cám ơn bạn đã trả lời, ý mình là con virus này tạo thêm một sheet có tên là XL4Poppy trong mỗi file excel. nên mình chỉ cần kiểm tra trong file nếu có đúng tên đó thì xóa ngược lại không làm gì cả .

đoạn code này mình không hiểu mong bạn giải thích thêm
If Sheets(wksName).Type = 3 Then SheetType = "MacroSheet"

Thực ra mình cũng ghi code để xóa sheet đó rồi nhưng bị vướn là đối với những file có password khi mở thì không làm được, nên sinh ra ý tưởng là đưa vào add-ins để tự động chạy luôn. Dưới đây là code VBA mình đã build

Sub CleanXL4Poppy()
Dim i As Long
i = 1
'---------
Dim fs

Dim mypath As String

Dim theSh As Object

Dim theFolder As Object



Set theSh = CreateObject("shell.application")

Set theFolder = theSh.BrowseForFolder(0, "", 0, "")

If Not theFolder Is Nothing Then

mypath = theFolder.Items.Item.Path

End If
'---------------

Dim str As String
If Len(Trim(ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Value)) <= 0 Then
str = "*" + ".xls"
Else
str = ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Value + ".xls"
End If
File_Search mypath, str, i
'"C:\Documents and Settings\Administrator\Desktop\ChungTuCo Macro", "*.xls", i
End Sub

Sub combine(Fpath As String, ByVal Fname As String, ByRef i As Long)


Dim nName As Name
Fname = Dir(Fpath & "\" & Fname)
On Error Resume Next
ThisWorkbook.Worksheets("Sheet1").Cells(8, 3).Value = "List of the files was cleaned Marco"
ThisWorkbook.Worksheets("Sheet1").Cells(8, 3).Font.ColorIndex = 3


Do While Fname <> ""
On Error Resume Next

Workbooks.Open Fpath & "\" & Fname
Application.DisplayAlerts = False

Sheets("XL4Poppy").Delete

ThisWorkbook.Worksheets("Sheet1").Cells(i + 9, 3).Value = Fpath & "\" & Fname

For Each nName In Names
If InStr(1, nName.Value, "#REF") Then
nName.Delete
End If
Next nName

'ActiveWorkbook.Names("p*").Delete

Application.DisplayAlerts = True
Workbooks(Fname).Close SaveChanges:=True

Fname = Dir
i = i + 1
Loop
'-------

End Sub
Sub File_Search(rootpath As String, ByVal filename As String, ByRef i As Long)
Dim DocName As String
Dim Search_Filter As String

combine rootpath, ByVal filename, i

Dim fs, f, s
On Error Resume Next

Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(rootpath)
Dim subfolder
Dim rootpathx As String
Set subfolder = f.subfolders
For Each f1 In subfolder
rootpathx = rootpath & "\" & f1.Name
File_Search rootpathx, ByVal filename, i
Next
End Sub
 
Cám ơn bạn đã trả lời, ý mình là con virus này tạo thêm một sheet có tên là XL4Poppy trong mỗi file excel. nên mình chỉ cần kiểm tra trong file nếu có đúng tên đó thì xóa ngược lại không làm gì cả .

đoạn code này mình không hiểu mong bạn giải thích thêm
If Sheets(wksName).Type = 3 Then SheetType = "MacroSheet"
Thì dùng để kiểm tra xem kiểu của sheet là Worksheet hay Macrosheet (con XL4Popy chính là Macrosheet)
Bạn nên nhớ rằng đâu phải con virus macro 4 nào cũng đặt tên sheet là XL4Popy. Vậy nếu gặp con khác thì.. nghỉ xóa à?
Vậy nên ta dùng code kiểm tra, thấy kiểu của sheet là Macrosheet thì xóa (hổng cần biết nó tên gì)
Thực ra mình cũng ghi code để xóa sheet đó rồi nhưng bị vướn là đối với những file có password khi mở thì không làm được, nên sinh ra ý tưởng là đưa vào add-ins để tự động chạy luôn. Dưới đây là code VBA mình đã build
Đương nhiên nếu mở file có pass thì dù các phần mềm viết sẵn cũng phải thua thôi
Giờ muốn viết thành AddIn thì ta không cần duyệt file trong thư mục làm gì. Cứ file nào mở lên thì code làm việc
Ví dụ thế này:
1> Chèn 1 ClassModule, đặt tên cho nó là wkbEvent
2> Chèn code dưới đầy vào Class Module
PHP:
Public WithEvents ExlApp As Application
Private Sub Class_Initialize()
  Set ExlApp = Application
End Sub
PHP:
Private Sub Class_Terminate()
  Set ExlApp = Nothing
End Sub
Mã:
Private Sub ExlApp_WorkbookOpen(ByVal Wb As Workbook)
  MsgBox "Có file moi mo"
  ''Thay MsgBox bằng code xóa sheet của bạn
End Sub
3> Chèn 1 Module và paste code dưới đây vào:
PHP:
Dim ExlObj As New wkbEvent
Sub Auto_Open()
  If ExlObj Is Nothing Then Set ExlObj = New wkbEvent
End Sub
PHP:
Sub Auto_Close()
  Set ExlObj = Nothing
End Sub
4> Lưu file thành 1 Add và thí nghiệm
 
Công ty mình đang bị con virus marco XL4Poppy, mình định viết code bằng VBA của excel đưa vào add-ins để xoá Sheet XL4Poppy một cách tự động sau khi mở file lên.

Mình không biết là sao để thực hiện công việc này.

Mong được được trợ giúp.
Theo mình thì sử dụng VirusMacroWarning của anh Nguyễn Duy Tuân cho chắc, không những xóa được những sheet dạng này nó còn làm được nhiều việc hơn thế nữa...
 
Thì dùng để kiểm tra xem kiểu của sheet là Worksheet hay Macrosheet (con XL4Popy chính là Macrosheet)
Bạn nên nhớ rằng đâu phải con virus macro 4 nào cũng đặt tên sheet là XL4Popy. Vậy nếu gặp con khác thì.. nghỉ xóa à?
Vậy nên ta dùng code kiểm tra, thấy kiểu của sheet là Macrosheet thì xóa (hổng cần biết nó tên gì)

Đương nhiên nếu mở file có pass thì dù các phần mềm viết sẵn cũng phải thua thôi
Giờ muốn viết thành AddIn thì ta không cần duyệt file trong thư mục làm gì. Cứ file nào mở lên thì code làm việc
Ví dụ thế này:
1> Chèn 1 ClassModule, đặt tên cho nó là wkbEvent
2> Chèn code dưới đầy vào Class Module
PHP:
Public WithEvents ExlApp As Application
Private Sub Class_Initialize()
  Set ExlApp = Application
End Sub
PHP:
Private Sub Class_Terminate()
  Set ExlApp = Nothing
End Sub
Mã:
Private Sub ExlApp_WorkbookOpen(ByVal Wb As Workbook)
  MsgBox "Có file moi mo"
  ''Thay MsgBox bằng code xóa sheet của bạn
End Sub
3> Chèn 1 Module và paste code dưới đây vào:
PHP:
Dim ExlObj As New wkbEvent
Sub Auto_Open()
  If ExlObj Is Nothing Then Set ExlObj = New wkbEvent
End Sub
PHP:
Sub Auto_Close()
  Set ExlObj = Nothing
End Sub
4> Lưu file thành 1 Add và thí nghiệm

wow, Mình test OK, đúng đây là cái mình cần.
Cám ơn bạn nhiều.
 
wow, Mình test OK, đúng đây là cái mình cần.
Cám ơn bạn nhiều.
Mình CẢM ƠN bạn đúng hơn!
Vì lâu lâu mới có 1 người nhìn code áp dụng được luôn
Khỏi giải thích và đưa file lên ---> Đở mất công mình ghê!
Ẹc... Ẹc... --=0
(Bệnh nguyên tuần nay, con mắt mờ luôn rồi)
 
Mình CẢM ƠN bạn đúng hơn!
Vì lâu lâu mới có 1 người nhìn code áp dụng được luôn
Khỏi giải thích và đưa file lên ---> Đở mất công mình ghê!
Ẹc... Ẹc... --=0
(Bệnh nguyên tuần nay, con mắt mờ luôn rồi)
Bạn ui,
Mình còn vướn chổ này cho mình hỏi luôn tí, hihi`
Về lý thuyết đã xóa được Sheet XL4Poppy rồi nhưng mình muốn tự động lưu luôn, chứ không khi user mở lên không chỉnh gì hết trong file mà đóng file nó hỏi có save không mà user chọn NO thì cũng như không?
Lần nữa xin cám ơn bạn nhiều.
 
Bạn ui,
Mình còn vướn chổ này cho mình hỏi luôn tí, hihi`
Về lý thuyết đã xóa được Sheet XL4Poppy rồi nhưng mình muốn tự động lưu luôn, chứ không khi user mở lên không chỉnh gì hết trong file mà đóng file nó hỏi có save không mà user chọn NO thì cũng như không?
Lần nữa xin cám ơn bạn nhiều.
Câu hỏi rất hay đây (mà làm được cũng.. tê)
Vì không biết code xóa sheet của bạn thế nào nên tôi làm 1 ví dụ khác:
1> Trong Class tên wkbEvent
PHP:
Public WithEvents ExlApp As Application
Private Sub Class_Initialize()
  Set ExlApp = Application
End Sub
PHP:
Private Sub Class_Terminate()
  Set ExlApp = Nothing
End Sub
Mã:
Private Sub ExlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
  Dim tmp As String
  If n > 0 Then
    tmp = vbTab & Join(Arr, vbTab) & vbTab
    If InStr(tmp, vbTab & Wb.Name & vbTab) Then 
      MsgBox "file này có sheet tên NDU"  ''----> Thay bằng việc lưu file wb.Save
    End If
  End If
End Sub
Mã:
Private Sub ExlApp_WorkbookOpen(ByVal Wb As Workbook)
  Dim wks As Worksheet
  For Each wks In Wb.Sheets
    If UCase(wks.Name) = "NDU" Then '' ---> Thay bằng điều kiện xóa sheet của bạn
      n = n + 1
      ReDim Preserve Arr(1 To n)
      Arr(n) = Wb.Name
    End If
  Next
End Sub
2> Code trong Module
PHP:
Dim ExlObj As New wkbEvent
Public Arr(), n As Long
Sub Auto_Open()
  If ExlObj Is Nothing Then Set ExlObj = New wkbEvent
End Sub
PHP:
Sub Auto_Close()
  Set ExlObj = Nothing
End Sub
Code trên sẽ kiểm tra những file vừa mở, nếu trong file có 1 sheet mang tên là "NDU" thì khi đóng file nó sẽ thông báo
Bạn tự mình sửa code cho trường hợp có sự kiện xóa sheet xãy ra thì lưu file nhé
-----------------------
Hoặc bạn cũng có cách khác đơn giản hơn: Khi sự kiện Private Sub ExlApp_WorkbookOpen kích hoạt, nếu có xóa sheet diễn ra thì lưu luôn (wb.Save)
 
Lần chỉnh sửa cuối:
Câu hỏi rất hay đây (mà làm được cũng.. tê)
Vì không biết code xóa sheet của bạn thế nào nên tôi làm 1 ví dụ khác:
1> Trong Class tên wkbEvent
PHP:
Public WithEvents ExlApp As Application
Private Sub Class_Initialize()
  Set ExlApp = Application
End Sub
PHP:
Private Sub Class_Terminate()
  Set ExlApp = Nothing
End Sub
Mã:
Private Sub ExlApp_WorkbookBeforeClose(ByVal Wb As Workbook, Cancel As Boolean)
  Dim tmp As String
  If n > 0 Then
    tmp = vbTab & Join(Arr, vbTab) & vbTab
    If InStr(tmp, vbTab & Wb.Name & vbTab) Then 
      MsgBox "file này có sheet tên NDU"  ''----> Thay bằng việc lưu file wb.Save
    End If
  End If
End Sub
Mã:
Private Sub ExlApp_WorkbookOpen(ByVal Wb As Workbook)
  Dim wks As Worksheet
  For Each wks In Wb.Sheets
    If UCase(wks.Name) = "NDU" Then '' ---> Thay bằng điều kiện xóa sheet của bạn
      n = n + 1
      ReDim Preserve Arr(1 To n)
      Arr(n) = Wb.Name
    End If
  Next
End Sub
2> Code trong Module
PHP:
Dim ExlObj As New wkbEvent
Public Arr(), n As Long
Sub Auto_Open()
  If ExlObj Is Nothing Then Set ExlObj = New wkbEvent
End Sub
PHP:
Sub Auto_Close()
  Set ExlObj = Nothing
End Sub
Code trên sẽ kiểm tra những file vừa mở, nếu trong file có 1 sheet mang tên là "NDU" thì khi đóng file nó sẽ thông báo
Bạn tự mình sửa code cho trường hợp có sự kiện xóa sheet xãy ra thì lưu file nhé
-----------------------
Hoặc bạn cũng có cách khác đơn giản hơn: Khi sự kiện Private Sub ExlApp_WorkbookOpen kích hoạt, nếu có xóa sheet diễn ra thì lưu luôn (wb.Save)

Bác thật là Bở Rồ,

Trong sự kiện WorkbookOpen mình thay nội dung
"n = n + 1
ReDim Preserve Arr(1 To n)
Arr(n) = Wb.Name"
thành wb.delete và sau NEXT mình wb.save nhưng khi mở file MS excel lại hỏi có xóa không, nếu chọn Yes mới xóa, còn No thì không xóa.

Ý mình muốn là mở file lên nếu sheet có tên thỏa điều kiện (ví dụ: NDU) thì xóa luôn không hỏi gì hết và tự động share luôn.

Rất mong được trợ giúp.
 
Bác thật là Bở Rồ,

Trong sự kiện WorkbookOpen mình thay nội dung
"n = n + 1
ReDim Preserve Arr(1 To n)
Arr(n) = Wb.Name"
thành wb.delete và sau NEXT mình wb.save nhưng khi mở file MS excel lại hỏi có xóa không, nếu chọn Yes mới xóa, còn No thì không xóa.

Ý mình muốn là mở file lên nếu sheet có tên thỏa điều kiện (ví dụ: NDU) thì xóa luôn không hỏi gì hết và tự động share luôn.

Rất mong được trợ giúp.
Việc xóa sheet muốn "trót lọt" mà không bị "hỏi thăm" gì ta phải thêm dòng Application.DisplayAlerts = False ở đầu code và Application.DisplayAlerts = True ở cuối code
Ví dụ thế này:
1> Code trong Module
PHP:
Dim ExlObj As New wkbEvent
Public chk As Boolean
Sub Auto_Open()
  If ExlObj Is Nothing Then Set ExlObj = New wkbEvent
End Sub
PHP:
Sub Auto_Close()
  Set ExlObj = Nothing
End Sub
2> Code trong ClassModule
PHP:
Public WithEvents ExlApp As Application
Private Sub Class_Initialize()
  Set ExlApp = Application
End Sub
PHP:
Private Sub Class_Terminate()
  Set ExlApp = Nothing
End Sub
Mã:
Private Sub ExlApp_WorkbookOpen(ByVal Wb As Workbook)
  Dim wks As Worksheet
  chk = False
  Application.DisplayAlerts = False
  For Each wks In Wb.Sheets
    If UCase(wks.Name) = "NDU" Then ''---> Chổ này là điều kiện xóa sheet của bạn
      wks.Delete
      chk = True
    End If
  Next
  If chk Then
    MsgBox "file này có sheet tên NDU"
    Wb.Save
  End If
  Application.DisplayAlerts = True
End Sub
(Code bài trước viết vội quá nên hơi bị... khùng chứ Bở Rồ gì)
 
Lần chỉnh sửa cuối:
Việc xóa sheet muốn "trót lọt" mà không bị "hỏi thăm" gì ta phải thêm dòng Application.DisplayAlerts = False ở đầu code và Application.DisplayAlerts = True ở cuối code
Ví dụ thế này:
1> Code trong Module
PHP:
Dim ExlObj As New wkbEvent
Public chk As Boolean
Sub Auto_Open()
  If ExlObj Is Nothing Then Set ExlObj = New wkbEvent
End Sub
PHP:
Sub Auto_Close()
  Set ExlObj = Nothing
End Sub
2> Code trong ClassModule
PHP:
Public WithEvents ExlApp As Application
Private Sub Class_Initialize()
  Set ExlApp = Application
End Sub
PHP:
Private Sub Class_Terminate()
  Set ExlApp = Nothing
End Sub
Mã:
Private Sub ExlApp_WorkbookOpen(ByVal Wb As Workbook)
  Dim wks As Worksheet
  chk = False
  Application.DisplayAlerts = False
  For Each wks In Wb.Sheets
    If UCase(wks.Name) = "NDU" Then ''---> Chổ này là điều kiện xóa sheet của bạn
      wks.Delete
      chk = True
    End If
  Next
  If chk Then
    MsgBox "file này có sheet tên NDU"
    Wb.Save
  End If
  Application.DisplayAlerts = True
End Sub
(Code bài trước viết vội quá nên hơi bị... khùng chứ Bở Rồ gì)

Một lần nữa thành thật cám ơn Bờ Rồ.
 
Web KT

Bài viết mới nhất

Back
Top Bottom