[已解决]请教老师们给予修改一下语句（备份XLS不保存宏）

whhy2009 · 发表于 2010-8-21 21:02

以下2--14行是从网上找的，加入后试验了一下，其结果是运行后宏模块未删除干净（7个模块中删除了6个，但以下语句的模块仍存在）。请教老师们给予修改。谢谢！！！

Sub 全部保存备份退出()
With Workbooks(Workbooks.Count) '以下开始删除VBA代码
        Dim vbcCom, Vbc
        Set vbcCom = .VBProject.VBComponents
        For Each Vbc In vbcCom
            If Vbc.Name Like "Sheet*" Or Vbc.Name Like "This*" Then
                Vbc.CodeModule.DeleteLines 1, Vbc.CodeModule.CountOfLines
            Else
                vbcCom.Remove (Vbc)
            End If
        Next Vbc
     '   .Save
     '   .Close
    End With '删除结束
ActiveWorkbook.SaveAs "E:\备份\" & Format(Now(), "yyyymmdd") & "日常统计(备份).xls"
MsgBox "以当天日期命名的文件己保存到：E:\备份\...下, 现全部退出Microsoft Excel,再见!!!"
Application.Quit

Workbooks.Close '关闭所有打开的工作簿
End Sub

最佳答案

月排行榜 / 总排行榜

knifefox

2010-8-22 14:21

Sub 全部保存备份退出()
        Dim vbcCom
        Dim Vbc As Object
        Dim WSH As Object
        Dim strVBS As String
        strVBS = Replace(UCase(ThisWorkbook.FullName), ".XLS", ".vbs") '
        Set WSH = CreateObject("Wscript.Shell")
        For Each Vbc In Application.ThisWorkbook.VBProject.VBComponents
            Select Case Vbc.Type
            Case 1, 2, 3
                With Application.VBE.ActiveVBProject.VBComponents
                    .Remove .Item(Vbc.Name)
                End With
            Case Else
                Vbc.CodeModule.DeleteLines 1, Vbc.CodeModule.CountOfLines
            End Select
        Next
    ActiveWorkbook.SaveAs "E:\备份\" & Format(Now(), "yyyymmdd") & "日常统计(备份).xls"
    MsgBox "以当天日期命名的文件己保存到：E:\备份\...下, 现全部退出Microsoft Excel,再见!!!"
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tf = fso.CreateTextFile(strVBS, True) '创建temp文件VBS文件
    With tf '写入VBS文件内容
        .WriteLine ("Set msexcel=GetObject(,""Excel.Application"")")
        .WriteLine ("msexcel.save")
        .WriteLine ("msexcel.quit")
        .WriteLine ("set fso=createobject(""scripting.filesystemobject"") ")
        .WriteLine ("fso.DeleteFile WScript.ScriptFullName")
        .Close
    End With
    WSH.Run Chr(34) & strVBS & Chr(34), 1, True
End Sub

[此贴子已经被作者于2010-8-22 14:21:33编辑过]

跳转到最佳答案楼层

scl5801 · 发表于 2010-8-21 21:48

嘿嘿哈哈[em01][em01]

scl5801 · 发表于 2010-8-21 21:48

手动啦

knifefox · 发表于 2010-8-21 23:19

Sub 全部保存备份退出()

        Dim vbcCom
        Dim Vbc As VBComponent
        For Each Vbc In Application.ThisWorkbook.VBProject.VBComponents
            If Vbc.Name Like "Sheet*" Or Vbc.Name Like "This*" Then
                Vbc.CodeModule.DeleteLines 1, Vbc.CodeModule.CountOfLines
            Else
                With Application.VBE.ActiveVBProject.VBComponents
                    .Remove .Item(Vbc.Name)
                End With
            End If
        Next Vbc
     '   .Save
     '   .Close

ActiveWorkbook.SaveAs "E:\备份\" & Format(Now(), "yyyymmdd") & "日常统计(备份).xls"
MsgBox "以当天日期命名的文件己保存到：E:\备份\...下, 现全部退出Microsoft Excel,再见!!!"
Application.Quit

Workbooks.Close '关闭所有打开的工作簿
End Sub

whhy2009 · 发表于 2010-8-21 23:48

刚运行了一下，出现提示如下：

用户定义类型未定

knifefox · 发表于 2010-8-22 00:36

工具引用 Microsoft Visual Basic for Application extensibility 5.3

whhy2009 · 发表于 2010-8-22 10:58

我已在“工具”菜单中的“ 引用”把 Microsoft Visual Basic for Application extensibility 5.3打勾了。虽没出现提示：用户定义类型未定义的信息。但保存退出后打开"备份.XLS"文件.其他已模块已删除,还仍保留一个模块的语句(以上的SUB 全部保存备份退出),再请教指导一下,谢谢!!!

knifefox · 发表于 2010-8-22 11:09

发你文件看看

whhy2009 · 发表于 2010-8-22 12:05

谢谢你的再次指教！！！！

NimaDsq4.rar (35.98 KB, 下载次数: 6)

knifefox · 发表于 2010-8-22 13:21

你这个比较麻烦了因为自己这个模块要等运行完了才删除所以删除前已经完成了保存的命令了

		自动登录	找回密码
密码			注册

[已解决]请教老师们给予修改一下语句（备份XLS不保存宏）

打开备份文件仍保留一个宏