Access 2016中Redemption Loader多用户COM引用缺失问题求助

核心问题分析 #

你直接使用CreateObject("Redemption.SafeMailItem")和CreateObject("Redemption.RDOSession")仍依赖COM组件注册，这与Redemption Loader的免注册动态加载逻辑冲突——Loader的作用是通过自定义函数加载本地DLL，而非调用系统注册的COM对象。

解决步骤 #

1. 正确部署Redemption DLL #

• 将购买的可分发版Redemption DLL（注意匹配32/64位，Access 2016默认是32位）复制到目标用户的数据库同一目录，或放入系统PATH可识别的文件夹中。
• 无需在目标机器注册DLL（regsvr32），Loader会自动加载本地文件。

2. 使用Loader模块的自定义函数创建对象 #

你添加的Redemption Loader模块（通常为RedemptionLoader.bas）包含CreateRedemptionObject函数，用它替代原生CreateObject：

' 替换原Set Redemption = CreateObject("Redemption.RDOSession")
Set Redemption = CreateRedemptionObject("Redemption.RDOSession")

' 替换原Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set SafeItem = CreateRedemptionObject("Redemption.SafeMailItem")

3. 移除Outlook常量依赖 #

代码中olFormatHTML是Outlook早期绑定常量，目标机器未引用Outlook库会报错，直接用对应数值替代：

' 替换SafeItem.BodyFormat = olFormatHTML
SafeItem.BodyFormat = 2 ' olFormatHTML对应数值为2

4. 可选：启动时检测Redemption可用性 #

如需提前验证，可在数据库启动窗体/模块中添加检测逻辑：

' 放在启动模块的AutoExec宏或Form_Load事件中
Sub CheckRedemptionAvailability()
    Dim obj As Object
    On Error Resume Next
    Set obj = CreateRedemptionObject("Redemption.RDOSession")
    If Err.Number <> 0 Then
        MsgBox "Redemption组件缺失，请确保Redemption.dll已放置在数据库目录。", vbCritical
        DoCmd.Quit
    End If
    Set obj = Nothing
End Sub

修改后的完整按钮代码 #

Private Sub SaveFirstAuth_Click()
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olMail As Object
    Dim SafeItem As Object
    Dim Redemption As Object
    Dim OrgURN As String
    Dim GrantURN As String
    On Error GoTo ErrorHandler

    OrgURN = "Org URN " & Me.OrganisationURN
    GrantURN = "Grant URN " & Me.GrantURN

    If IsNull(Me.FirstAuthorisation) Or IsNull(Me.FirstAuthorisationDate) Or IsNull(Me.FinalAuthorisation) Then
        MsgBox "Please add first authorisation, date and final authorisation"
        Exit Sub
    End If

    'Email message text
    Dim msg As String
    msg = "Organisation Name: " & OrganisationName & ",<p>" _
        & GrantURN & ",<p>" & "Payment ready for final authorisation."

    'Create outlook session
    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")
    olNamespace.Logon 'logon to outlook
    
    'Create a new mail item
    Set olMail = olApp.CreateItem(0) '0 = olMailItem
    ' 使用Redemption Loader的函数创建对象
    Set SafeItem = CreateRedemptionObject("Redemption.SafeMailItem")
    SafeItem.Item = olMail
        
    'Set sender address, text format, recipient, subject and send
    SafeItem.SentOnBehalfOfName = "crtsupport@coalfields-regen.org.uk"
    SafeItem.BodyFormat = 2 ' 替代olFormatHTML
    SafeItem.HTMLBody = msg
    SafeItem.To = Me.FinalAuthorisation.Column(1)
    SafeItem.Subject = "Payment for Authorisation"
    SafeItem.Send
    SafeItem.SaveAs "\\IT\CRTSupportDatabase\Documents\" & OrgURN & "\" & GrantURN & "\" & "Payment Authorised.msg"

    'Disable authorisation fields and update payment status
    FirstAuthorisation.Enabled = False
    FirstAuthorisationDate.Enabled = False
    FinalAuthorisation.Enabled = False
    
    Me.PaymentStatus = "Awaiting final authorisation"
    Me.SaveFirstAuth.Enabled = False

    MsgBox "Payment authorised"
    Me.Dirty = False
    DoCmd.Close

Cleanup:
    Set SafeItem = Nothing
    Set olMail = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing
    Set Redemption = Nothing
    Exit Sub

ErrorHandler:
    Dim ErrMsg As String
    ErrMsg = Err.Number & ":" & Err.Description
    MsgBox ErrMsg
    Resume Cleanup
End Sub

关键注意事项 #

• 确保目标机器的Redemption DLL版本与开发机一致，且匹配Access的位数（32/64位）。
• 不要在目标机器注册Redemption DLL，否则会覆盖Loader的动态加载逻辑。
• 若仍报错，检查Loader模块是否完整导入，确保CreateRedemptionObject函数存在且无语法错误。

内容的提问来源于stack exchange，提问作者AlliCarr