求助：定时归档代理出错

就是得到路径打开对应库的时候报错：

代码如下：

Sub Initialize
%REM
定时归档
创建时间:2013-3-20
%END REM

On Error Goto errormsg

Dim gurl As String

Dim getPath As String

getPath=Strleftback(goalcPath,"")

If getPath="" Then

getPath="linkeyarc.nsf"

Else

getPath=getPath+"linkeyarc.nsf"

End If



Dim session As New notessession

Dim wdb As NotesDatabase

Dim wview As NotesView

Dim wdelview As NotesView

Dim wdc As NotesDocumentCollection

Dim dc As NotesDocumentCollection

Dim lockview As NotesView

Dim lockdc As NotesDocumentCollection

Dim wdoc As NotesDocument

Dim movedoc As NotesDocument

Dim munid As String

Dim strq As String

Set wdb=session.currentdatabase

Set wview = wdb.GetView("viewguidanglist")


Msgbox "批量归档统计开始(wview.count)"

Msgbox wview.AllEntries.count

For p=0 To wview.AllEntries.count

Set wdoc = wview.GetFirstDocument

If Not wdoc Is Nothing Then

munid = wdoc.docUNID(0)

'文档存盘时首先解除本用户锁定的所有文档

Set lockview=wdb.getview("viewWorkflowLockDoc")

Set lockdc=lockview.getalldocumentsbykey(munid,True)

Call lockdc.removeall(True)

'解锁结束



Dim dbpath As String

If Instr(wdoc.path(0),"")>0 Then

dbpath=Strrightback(wdoc.path(0),"")

Else

dbpath=Strrightback(wdoc.path(0),"/")

End If



If dbpath<>"" Then

Dim gdb As NotesDatabase

Dim gview As NotesView

Dim gdoc As NotesDocument



Set gdb=opendb(dbpath)

Set gview=gdb.getview("All")

Set gdoc=gview.getdocumentbykey(wdoc.docUNID(0),True)

If Not gdoc Is Nothing Then

Call SaveMainDoc(gdoc)

'加强版，增加MainType和SubType为空时判断数据库类别再赋值start

If gdoc.MainType(0)="" Then

If dbpath="linkey_sw.nsf" Then

gdoc.MainType="收文文件"

Elseif dbpath="linkey_fw.nsf" Then

gdoc.MainType="发文文件"

End If

End If

If gdoc.SubType(0)="" Then

gdoc.SubType=Mid(gdoc.Created,1,4)

End If

'加强版，增加MainType和SubType为空时判断数据库类别再赋值end


Call GuidDanNew(gdoc,gdoc.Universalid,getPath,"3",gdoc.CanReaderUser,"归档",gdoc.MainType(0),gdoc.SubType(0))

gdoc.form="NewDoc"

gdoc.Stauts="2"

Call gdoc.save(True,True)

If gdoc.deldoc(0)<>"1" Then'删除副本

Call EditToDoDocURL()

Msgbox "("+dbpath+"):"+gdoc.Subject(0)

Call gdoc.remove(True)'删除主文档


Set wdelview=wdb.getview("delall")

Set wdc=wdelview.getalldocumentsbykey(wdoc.docUNID(0),True)

'删除所有跟踪文档

'Msgbox "所有跟踪文档统计(wdc.count)"

'Msgbox wdc.count

Call wdc.removeall(True)

End If



Dim SendTo As Variant

Dim NotesSubject,NotesBody

Dim arcdb As NotesDatabase

Dim arcdbpath As String

Dim arcview As NotesView

Dim arcdoc As NotesDocument

If Instr(getPath,"")>0 Then

arcdbpath=Strrightback(getPath,"")

Else

arcdbpath=Strrightback(getPath,"/")

End If

If arcdbpath<>"" Then

Set arcdb=opendb(arcdbpath)

Set arcview=arcdb.getview("viewdoclistbyunid")

Set arcdoc=arcview.getdocumentbykey(munid+"00",True)


SendTo=arcdoc.CanReaderUser

SendTo=Arrayappend(SendTo,arcdoc.CanPrintUser)

SendTo=Arrayappend(SendTo,arcdoc.CanCheckOutUser)

SendTo=Arrayappend(SendTo,arcdoc.CanReaderForm)

SendTo=myunique(SendTo)

NotesSubject=arcdoc.SendToSubject(0)

NotesBody=arcdoc.getitemvalue("SendToBody")(0)

NotesBody=Replace(NotesBody,"$$arcurl",""+arcdoc.Subject(0)+"")


If arcdoc.SendDoc(0)="1" Then'发送邮件

On Error Resume Next

Call SendMail(SendTo,NotesSubject,NotesBody,goalCUserName)


Elseif arcdoc.SendDoc(0)="2" Then'发送短消息

Call SendSms(goalCUserName,SendTo,NotesSubject,NotesBody,"1","0")

End If

End If

Else

'在实例库有文档，但在应用库找不到的文档，作迁移到历史实例库处理（先检查应用库的all视图，是否有问题，如果没问题再迁移）

'Msgbox dbpath+" no doc:"+munid +" " +wdoc.Created +" ,please check (all) view"

Set wdelview=wdb.getview("delall")

Set wdc=wdelview.getalldocumentsbykey(wdoc.docUNID(0),True)

Set movedoc=wdc.getfirstdocument

While Not movedoc Is Nothing

Call MoveHistory(movedoc)

Set movedoc=wdc.getnextdocument(movedoc)

Wend

'删除所有跟踪文档

'Msgbox dbpath+"删除所有跟踪文档统计(wdc.count)"

'Msgbox wdc.count

Call wdc.removeall(True)

End If

End If

Call wview.Refresh

End If

Next



Msgbox "批量归档结束!!!"

'Print ""




Exit Sub
errormsg:

Msgbox "wf_agentguidang init Error:" & Str(Erl) & "  " & Error
End Sub