[已解决]分享用VBA读写excel文档属性的两点应用及想法

上清宫主

近来看到有限制文件使用次数的帖子，要想实现的话，得有个地方来记忆已用次数，这样就想到可不可以利用文档属性来实现记忆使用的次数呢？试了几次感觉这种想法可以实现，故发出来以供商榷。敬请各位斧正

文档属性：

分享用VBA读写excel文档属性

[此贴子已经被作者于2010-5-9 8:12:04编辑过]

最佳答案

月排行榜 / 总排行榜

amulee

2010-5-10 11:26

也可以通过注册表来存储信息。

Sub 限制运行次数()
    Dim Times
    Times = GetSetting("RnTime", "Set", "Times")
    If Len(Times) > 0 Then
        Times = CInt(Times)
        If Times = 0 Then
            MsgBox "该程序已经使用三次！"
            Exit Sub
        Else
            Times = Times - 1
            MsgBox "该程序已经使用" & 3 - Times & "次。还有" & Times & "次使用机会"
            SaveSetting "RnTime", "Set", "Times", Times
        End If
    Else
        SaveSetting "RnTime", "Set", "Times", 2 '初次运行，设定可以使用三次
        MsgBox "该程序可以使用三次，还有两次使用机会"
    End If
    '以下为主程序
    MsgBox "主程序正在运行"
End Sub

Sub 限制运行期限()
    Dim Times
    Times = GetSetting("RnTime", "Set", "Times")
    If Len(Times) > 0 Then
        Times = CDate(Times)
        If Times < Date Then
            MsgBox "已超过时限"
            Exit Sub
        End If
    Else
        SaveSetting "RnTime", "Set", "Times", DateAdd("d", 29, Date) '初次运行，设定可以使用三次
        MsgBox "该程序可以使用30天。有效期至" & DateAdd("d", 29, Date)
    End If
    '以下为主程序
    MsgBox "主程序正在运行"
End Sub

跳转到最佳答案楼层

上清宫主

[hide

]

 

'每一工作簿都有一个内置文档属性集合和一个自定义文档属性的集合
'使用BuiltinDocumentProperties可获取内置文档属性集合，而使用CustomDocumentProperties可获取自定义文档属性的集合
'BuiltinDocumentProperties获取的内置文档属性集合中，常见的有author(作者)、title(标题)、subject(主题)、
'keywords(关键词)、Category(类别)、Content status(状态)、comments(备注)、Manager(经理)、Company(公司)、
'Last print date、Creation date、Last save time、Total editing time等等
'CustomDocumentProperties获取的自定义文档属性的集合，则你定义有什么，就可获取什么
'实例:
Sub test1()
s$ = ThisWorkbook.BuiltinDocumentProperties.Item("author")  '获取作者赋给变量s
ThisWorkbook.BuiltinDocumentProperties.Item("author") = "上清宫主"  '将作者名改为上清宫主
s2$ = ThisWorkbook.BuiltinDocumentProperties.Item("comments")   '获取备注赋给变量s
ThisWorkbook.BuiltinDocumentProperties.Item("comments") = "上清宫主"  '将备注改为上清宫主
End Sub
Sub test2()
ThisWorkbook.CustomDocumentProperties.Add Name:="my1", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=1000
'定义一个名为my1的数字型属性、初始值为1000。当然也可以手动定义
'注：type可为msoPropertyBoolean、msoPropertyDate、msoPropertyFloat、msoPropertyNumber 或 msoPropertyString之一
MsgBox ThisWorkbook.CustomDocumentProperties("my1")   '获取自定义的my1的值
End Sub

[/hide]

[此贴子已经被作者于2010-5-9 7:37:49编辑过]

上清宫主

[hide]

要实现限制文件的使用次数，想来应该在某个地方存储文档已用的次数，并且在文档每被使用一次这个使用次数就得发生相应的更改。如果这个思路正确的话，我们就可以利用文档属性的某个位置来实现这一想法，故有了以下两种形式：

一、利用自定义属性：因为我们可以自定义数字型的属性，这一点非常符合我们的需求

先用一行代码ThisWorkbook.CustomDocumentProperties.Add Name:="open_times", LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=10来定义一个名为open_times的数字型属性、初始值为10。当然也可以手动定义

然后在文档的打开事件中写入：

Private Sub Workbook_Open()
If ThisWorkbook.CustomDocumentProperties("open_times") < 1 Then
  MsgBox "可用次数已小于1"
Else
  ThisWorkbook.CustomDocumentProperties("open_times") = ThisWorkbook.CustomDocumentProperties("open_times") - 1
End If
End Sub

注：1、这里我们只讨论在必须启用宏的情况下。2、这里只写了打开文档的次数，要想保存、修改等等，请作相应改动。3、限制的代码请自行修改，此处只写了MsgBox "可用次数已小于1"这么一个提示信息

二、上一个方法自然、直观，但不隐蔽。再利用内置文档属性直观上不容易发现的：

先用一行代码ThisWorkbook.BuiltinDocumentProperties.Item("comments")=""将备注清空，然后文档每打开一次其备注增加一个空格，再判断其长度，当长度达到我们的限制要求时，作相应操作：

Private Sub Workbook_Open()
ThisWorkbook.BuiltinDocumentProperties.Item("comments") = ThisWorkbook.BuiltinDocumentProperties.Item("comments") & " "
If Len(ThisWorkbook.BuiltinDocumentProperties.Item("comments")) > 10 Then
  MsgBox "已超过可用次数"
End If
End Sub

注：同前，限制的代码请自行修改，此处只写了一个提示信息

[/hide

]

[此贴子已经被作者于2010-5-9 8:09:29编辑过]

上清宫主

还有使用时间限制、保存时间限制、只能在自己的机子上使用等等诸如此类的，但想去想来，无非就是这几个属性的应用而已，而且坛子中高手如云、网友的想法精彩纷存，要是再写下去无非是怡笑大方，且又会被指灌水。还是省省吧。

敬请各位批评指正，谢谢！

[此贴子已经被作者于2010-5-9 8:30:05编辑过]

amulee

也可以通过注册表来存储信息。

Sub 限制运行次数()
    Dim Times
    Times = GetSetting("RnTime", "Set", "Times")
    If Len(Times) > 0 Then
        Times = CInt(Times)
        If Times = 0 Then
            MsgBox "该程序已经使用三次！"
            Exit Sub
        Else
            Times = Times - 1
            MsgBox "该程序已经使用" & 3 - Times & "次。还有" & Times & "次使用机会"
            SaveSetting "RnTime", "Set", "Times", Times
        End If
    Else
        SaveSetting "RnTime", "Set", "Times", 2 '初次运行，设定可以使用三次
        MsgBox "该程序可以使用三次，还有两次使用机会"
    End If
    '以下为主程序
    MsgBox "主程序正在运行"
End Sub

Sub 限制运行期限()
    Dim Times
    Times = GetSetting("RnTime", "Set", "Times")
    If Len(Times) > 0 Then
        Times = CDate(Times)
        If Times < Date Then
            MsgBox "已超过时限"
            Exit Sub
        End If
    Else
        SaveSetting "RnTime", "Set", "Times", DateAdd("d", 29, Date) '初次运行，设定可以使用三次
        MsgBox "该程序可以使用30天。有效期至" & DateAdd("d", 29, Date)
    End If
    '以下为主程序
    MsgBox "主程序正在运行"
End Sub

上清宫主

谢谢8楼。

就使用次数来说，记录使用次数的地方个人感觉不外乎就这么几种，并各有长短:

注册表：得绕过防毒程序，不能防备重装机、不同计算机上等的重复应用

文档属性：太弱，非常容易手工改回来

另存于其它文件（如txt文件）：很容易找到并被删除或改动、不同计算机重复使用

还有一种（没去试过，想来应该可以实现）：文件本身由很多区段，不同段代表不同含义，这之间有空白位置，应该可以通过相应代码来对这个位置进行读写，这应该是最隐蔽、最不好破坏的。

希望能有大大写出最后这种形式。

hjcexecl

Sub 限制运行次数()
    Dim Times
    Times = GetSetting("RnTime", "Set", "Times")
    If Len(Times) > 0 Then
        Times = CInt(Times)
        If Times = 0 Then
            MsgBox "该程序已经使用三次！"
            Exit Sub
        Else
            Times = Times - 1
            MsgBox "该程序已经使用" & 3 - Times & "次。还有" & Times & "次使用机会"
            SaveSetting "RnTime", "Set", "Times", Times
        End If
    Else
        SaveSetting "RnTime", "Set", "Times", 2 '初次运行，设定可以使用三次
        MsgBox "该程序可以使用三次，还有两次使用机会"
    End If
    '以下为主程序
    MsgBox "主程序正在运行"
End Sub

Sub 限制运行期限()
    Dim Times
    Times = GetSetting("RnTime", "Set", "Times")
    If Len(Times) > 0 Then
        Times = CDate(Times)
        If Times < Date Then
            MsgBox "已超过时限"
            Exit Sub
        End If
    Else
        SaveSetting "RnTime", "Set", "Times", DateAdd("d", 29, Date) '初次运行，设定可以使用三次
        MsgBox "该程序可以使用30天。有效期至" & DateAdd("d", 29, Date)
    End If
    '以下为主程序
    MsgBox "主程序正在运行"
End Sub

hjcexecl

Sub 限制运行次数()
    Dim Times
    Times = GetSetting("RnTime", "Set", "Times")
    If Len(Times) > 0 Then
        Times = CInt(Times)
        If Times = 0 Then
            MsgBox "该程序已经使用三次！"
            Exit Sub
        Else
            Times = Times - 1
            MsgBox "该程序已经使用" & 3 - Times & "次。还有" & Times & "次使用机会"
            SaveSetting "RnTime", "Set", "Times", Times
        End If
    Else
        SaveSetting "RnTime", "Set", "Times", 2 '初次运行，设定可以使用三次
        MsgBox "该程序可以使用三次，还有两次使用机会"
    End If
    '以下为主程序
    MsgBox "主程序正在运行"
End Sub

shiwenzan

标记一下，以便后期学习使用！