[已解决]新年度自动备份数据出错问题

sdwffw

工业产品档案管理.zip (23.36 KB, 下载次数: 28)

2014-5-15 09:02 上传

点击文件名下载附件

做了一个小程序，想实现在进入新年度后，出现备份提示，输入继续工作密码后（为系统当天日期,如今天密码是20140515），在D盘建立许可档案备份目录，以“上年度年号+工业产品档案备份”自动备份出文件，备份的文件为纯excel文件，删除VBA代码，删掉模块。如果密码输错，系统退出。
运行时，在备份文件删除VBA代码、模块时，提示错误，



不知何因，请老师指教，十分感谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-5-15 11:32

1. Private Sub Workbook_Open()
   
2.     Sheet1.Activate
   
3.     If Year(Date) > Sheet4.[b2] Then
   
4.         MsgBox "新年度在d盘许可档案备份目录下自动备份上年度档案表,清空后重新开始工作！", , "提示"
   
5.         aa = InputBox("请输入继续工作密码！", "密码录入")
   
6.         ' DoEvents
   
7.         If aa = VBA.Format(VBA.Date, "YYYYMMDD") Then
   
8.             MsgBox "密码正确!欢迎在新年度使用系统!"
   
9.             Application.DisplayAlerts = False
   
10.             Application.EnableEvents = False
    
11.             Application.ScreenUpdating = False
    
12. 
    
13.             Dim TheBackUpDir As String
    
14.             Dim strFile$
    
15.             TheBackUpDir = "D:\许可档案备份"
    
16.             If Len(Dir(TheBackUpDir, vbDirectory)) = 0 Then
    
17.                 MkDir TheBackUpDir
    
18.             End If
    
19.             strFile = TheBackUpDir & "" & Year(Date) - 1 & "工业产品档案备份.xls"
    
20.             ThisWorkbook.SaveCopyAs strFile
    
21.             With GetObject(strFile)
    
22.                 MsgBox .Name
    
23.                 .Windows(1).Visible = True
    
24.                 For Each ms In .Sheets(1).Shapes
    
25.                     If ms.Type = 6 Or ms.Type = 8 Then ms.Delete
    
26.                 Next ms
    
27.                 For Each vbc In .VBProject.VBComponents
    
28.                     Select Case vbc.Type
    
29.                         Case 100
    
30.                             vbc.CodeModule.DeleteLines 1, vbc.CodeModule.CountOfLines
    
31.                         Case Else
    
32.                             .VBProject.VBComponents.Remove vbc
    
33.                     End Select
    
34.                 Next vbc
    
35.                 .Close True
    
36.             End With
    
37.             Sheet1.Range("A3:T" & Sheet1.Range("A65536").End(3).Row).ClearContents
    
38.             Sheet4.[b2] = Year(Date)
    
39.             Sheet1.Select
    
40.         Else
    
41.             MsgBox "密码错误,程序退出！"
    
42.             Application.Quit
    
43.             ' ActiveWorkbook.Close False
    
44.         End If
    
45. 
    
46.     End If
    
47.     Application.DisplayAlerts = True
    
48.     Application.EnableEvents = True
    
49.     Application.ScreenUpdating = True
    
50. End Sub

复制代码

跳转到最佳答案楼层

sdwffw

自动备份后，系统清除表一数据，表四年度时间变为本年度，重新开始新年度工作

hwc2ycy

看看引用的range对象是不是空的了。

sdwffw

hwc2ycy 发表于 2014-5-15 09:30
看看引用的range对象是不是空的了。

感谢老师关注。引用的range对象不是空的吧？备份出的表中，VBA编码和模块也未删除掉。VBA我刚刚开始学习，请老师多指点。

hwc2ycy

你用的是savecopyas方法，是重新备份一个。当前的工作簿还是原来的不是新备份的。
你的错误是还有个change事件。
可以在在调用clearcontents方法前先禁用事件。

hwc2ycy

SaveCopyAs 方法
参阅参阅参阅参阅将指定工作簿的副本保存到文件，但不更改内存中的打开工作簿。

hwc2ycy

SaveCopyAs 方法
参阅参阅参阅参阅将指定工作簿的副本保存到文件，但不更改内存中的打开工作簿。

1.     Sheet1.Activate
   
2.     If Year(Date) > Sheet4.[b2] Then
   
3.         MsgBox "新年度在d盘许可档案备份目录下自动备份上年度档案表,清空后重新开始工作！", , "提示"
   
4.         aa = InputBox("请输入继续工作密码！", "密码录入")
   
5.         ' DoEvents
   
6.         If aa = VBA.Format(VBA.Date, "YYYYMMDD") Then
   
7.             MsgBox "密码正确!欢迎在新年度使用系统!"
   
8. 
   
9.             Dim TheBackUpDir As String
   
10.             TheBackUpDir = "D:\许可档案备份"
    
11.             If Len(Dir(TheBackUpDir, vbDirectory)) = 0 Then
    
12.                 MkDir TheBackUpDir
    
13.             End If
    
14.             ThisWorkbook.SaveAs TheBackUpDir & "" & Year(Date) - 1 & "工业产品档案备份.xls"
    
15.             With ActiveWorkbook
    
16. 
    
17.                 For Each ms In .Sheets(1).Shapes
    
18.                     If ms.Type = 6 Or ms.Type = 8 Then ms.Delete
    
19.                 Next ms
    
20.                 For Each vbc In .VBProject.VBComponents
    
21.                     If vbc.Type = 100 Then
    
22.                         vbc.CodeModule.DeleteLines 1, vbc.CodeModule.CountOfLines
    
23.                     End If
    
24.                 Next vbc
    
25. 
    
26.             End With
    
27.             Application.EnableEvents = False
    
28.             Sheet1.Range("A3:T" & Sheet1.Range("A65536").End(3).Row).ClearContents
    
29.             Sheet4.[b2] = Year(Date)
    
30.             Sheet1.Select
    
31.             Application.EnableEvents = True
    
32.         Else
    
33.             MsgBox "密码错误,程序退出！"
    
34.             Application.Quit
    
35.             ' ActiveWorkbook.Close False
    
36.         End If
    
37.     End If

复制代码

sdwffw

hwc2ycy 发表于 2014-5-15 10:33
SaveCopyAs 方法
参阅参阅参阅参阅将指定工作簿的副本保存到文件，但不更改内存中的打开工作簿。

谢谢老师，测试发现，备份出的表没有数据了。同时虽然没有VBA码，但模块未删除

sdwffw

hwc2ycy 发表于 2014-5-15 10:33
SaveCopyAs 方法
参阅参阅参阅参阅将指定工作簿的副本保存到文件，但不更改内存中的打开工作簿。

想法是备份出的表保留数据，去掉VBA编码和模块，并不需要同时打开此备份表。备份结束后，原表只清除数据，保留程序功能，“设置表”中时间改为当前年度，重新开始工作。

hwc2ycy

模块的删除因为你原来的代码里没有针对标准模块做删除操作，呆会我再改下。