frmtmpsw.frm

vb 调用ＩＢＭ ｄｏｍｉｎｏ ｓｅｒｖｅｒ数据库的例子

'                DoEvents
'            Next
'            wddoc.SaveAs (txtswYWPath + doc.GetItemValue("DocID")(0) + "(yj).doc")  '另存为一个文档
'            wddoc.Close
'            Set wddoc = Nothing
'            wdapp.Quit
'       ''''''''''''''''''''''''''''''''''''''''''''''end
''        ''''''''''''''''''''''''''''''''' 从配置文档中取出意见字段的对应值
''            Me.List3.Clear
''            Me.List4.Clear
''
''            'Dim tmpj As Integer
''            For tmpj = 0 To UBound(AllAdviceNames)
''                AdviecName = Split(AllAdviceNames(tmpj), "=")
''                Me.List3.AddItem AdviecName(1)   'list3中存放关系数据库中字段的名称，即=右边的
''                Me.List4.AddItem AdviecName(0)   'list4中存放Domino数据库中对应的域名，即=左边的
''            Next
''            ''''''''''''''''''''''''''''''''
''            For tmpj = 0 To List3.ListCount - 1
''               If doc.HasItem(List4.List(tmpj)) Then
''                  rs.Fields(List3.List(tmpj)) = CStr(doc.GetFirstItem(List4.List(tmpj)).Text)
''               End If
''            Next
''
'           ''''''''''''''''''''''''''''''''''''''''''''''end
'           Call getMaxID    '得到目录表中的最大id
'
'
'           '''''''''''导出原文
'           Dim allItem As NotesItem
'
'           Dim strAttDocID As String
'           strAttDocID = doc.GetItemValue("AttDocID")(0)
'           Dim AttView As NotesView
'           Dim Attdc As NotesDocumentCollection
'           Dim Attdoc As NotesDocument
'           Dim i As Variant
'           Dim o As Variant
'           Dim emb As Variant
'           Dim AttObjects As NotesEmbeddedObject
'           Dim path As String
'           Dim entPath As String
'           Dim count As Integer
'           Dim docRS As New ADODB.Recordset
'           docRS.Open "select * from " & txtswYW, Gcon_main, adOpenDynamic, adLockOptimistic
'           count = 0
'           path = txtswYWPath '存放附件的路径，到时候你可以修改成你们的路径
'        ''''''''''''''''''' 把生成的word文档信息存到sys_link 中
'           docRS.AddNew
'           docRS.Fields("I_TBLID") = 29
'           docRS.Fields("I_RECID") = MaxID
'           docRS.Fields("C_NUM") = count
'           docRS.Fields("C_EXPLAIN") = "意见"
'           docRS.Fields("C_LINK") = txtswYWHttpPath + doc.GetItemValue("DocID")(0) + "(yj).doc"
'           docRS.Update
'
'       '''''''''''''''''''end
'           ''''''拆离文档中的附件
'           If strAttDocID <> "" Then
'              Set AttView = PublicNotesDb.GetView("(AttachUnid)")
'
'              Set Attdoc = AttView.GetDocumentByKey(strAttDocID)
'              If Attdoc.HasEmbedded Then
'                 Dim attitem As NotesItem
'                 Set attitem = Attdoc.GetFirstItem("attnames")
'
'                 For Each i In attitem.Values
'                     Set AttObjects = Attdoc.GetAttachment(i)
'                     entPath = path + strAttDocID + "_" + CStr(count) + "_" + Right(AttObjects.Source, 4)
'                     Call AttObjects.ExtractFile(entPath)  ''''把附件拆到指定的路径下
'                  '''''''往原文表中添加相应的纪录
'                     docRS.AddNew
'                     docRS.Fields("I_TBLID") = 29
'                     docRS.Fields("I_RECID") = MaxID
'                     docRS.Fields("C_NUM") = count + 1
'                     docRS.Fields("C_EXPLAIN") = "正文"
'                     docRS.Fields("C_LINK") = txtswYWHttpPath + strAttDocID + "_" + CStr(count) + "_" + Right(AttObjects.Source, 4)
'
'                     docRS.Update
'
'                  '''''''''''''''''''''''''''''''''''end
'                     count = count + 1
'
'                  Next
'              End If
'           End If
'
'
'          ''''''''''''''''''拆离收文中的嵌入式文档，包括红头文件和过程性文件
'            Dim strExplain As String
'            For Each i In Session.Evaluate("@AttachmentNames", doc)
'                Set AttObjects = doc.GetAttachment(i)
'                If AttObjects Is Nothing Then
'                Else
'                    If InStr(1, AttObjects, "modify") > 0 Then
'                        entPath = doc.GetItemValue("docId")(0) + "(modify)" + Right(AttObjects.Source, 4)
'                        Call AttObjects.ExtractFile(path + entPath)
'                        strExplain = "过程性文件2"
'                    ElseIf InStr(1, AttObjects, "draft") > 0 Then
'                        entPath = doc.GetItemValue("docId")(0) + "(draft)" + Right(AttObjects.Source, 4)
'                        Call AttObjects.ExtractFile(path + entPath)
'                        strExplain = "过程性文件1"
'                    Else
'                        entPath = doc.GetItemValue("docId")(0) + Right(AttObjects.Source, 4)
'                        Call AttObjects.ExtractFile(path + entPath)
'                        strExplain = "正文"
'                    End If
'
'                    docRS.AddNew
'                    docRS.Fields("I_TBLID") = 29
'                    docRS.Fields("I_RECID") = MaxID
'                    docRS.Fields("C_NUM") = count + 1
'                    docRS.Fields("C_EXPLAIN") = strExplain
'                    docRS.Fields("C_LINK") = txtswYWHttpPath + entPath '需要修改，改成你们的相应连接
'                    docRS.Update
'                End If
'                count = count + 1
'            Next
'
'           '''''''''''''''''''''''''''''''''''''''''''''end
'       End If
'       Gcon_main.Execute "delete from 临时文书档案一文一件 where ID=" & usql
'      ' AdviceRs.Close
'       tmpRS.Close
'       rs.Close
'       docRS.Close
'       Set item = doc.ReplaceItemValue("ISENDARC", "1")
'       Call doc.Save(True, True)
'   Next
'   Call GridEX1.Refresh
'
'   MsgBox "数据导入成功！"
'End Sub
'
'Private Sub Form_Load()
'
'Dim C As NotesViewColumn
'
'Dim Mycount As Integer
''''连接到Domino数据库
'Set PublicNotesDb = Session.GetDatabase(txtswDominoServer, txtswDominoDatabase) '需要修改 ,前面是oa服务器的名称(这个需要修改的)。后面是数据库的名称(这个应该不用改，这个路经和你们现在的路径是一致的)
'
'If PublicNotesDb Is Nothing Then
'
'   MsgBox ("不能打开Notes库，请查看系统设置！")
'
'End If
'Gcon_main.Execute "Delete  from 临时文书档案一文一件"  '首先删除临时表里面的数据
'Dim rs As New ADODB.Recordset
'rs.Open "Select * from 临时文书档案一文一件", Gcon_main, adOpenDynamic, adLockOptimistic
'
'Dim j As Integer
'Set view = PublicNotesDb.GetView(txtswview) '得到存放办结文件的试图
'
'Dim doc As NotesDocument
'Set doc = view.GetFirstDocument
'Dim i As Integer
'
'''''''''''''''''''''''''''''''''' 从配置文档中取出字段的对应值
'Me.List1.Clear
'Me.List2.Clear
'Dim OldNames() As String
'Dim name() As String
'OldNames = Split(txtswZD, ",")
'Dim tmpj As Integer
'For tmpj = 0 To UBound(OldNames)
'    name = Split(OldNames(tmpj), "=")
'    Me.List1.AddItem name(1)   'list1中存放关系数据库中字段的名称，即=左边的
'    Me.List2.AddItem name(0)   'list1中存放Domino数据库中对应的域名，即=右边的
'Next
'''''''''''''''''''''''''''''''''
'Dim strTmpYear As String
'While i < 500
'   '取出导出标记为空，创建超过2个月的文档
'   'If doc.GetFirstItem("TagOfDyp") Is Nothing And DateDiff("m", CDate(doc.Created), CDate(Now)) > 2 Then
'  If doc Is Nothing Then
'     i = i + 1
'  Else
'
'    'If doc.GetFirstItem("ISENDARC") Is Nothing And doc.GetItemValue("ISNEEDARC")(0) = "1" And DateDiff("m", CDate(doc.Created), CDate(Now)) > 2 Then
'    If doc.GetItemValue("ISNEEDARC")(0) = "1" And DateDiff("m", CDate(doc.Created), CDate(Now)) > 2 Then
'       rs.AddNew
'       For tmpj = 0 To List1.ListCount - 1
'           If List1.List(tmpj) = "成文日期" Or List1.List(tmpj) = "登记日期" Then
'              rs.Fields(List1.List(tmpj)) = Left(GetNotNull(doc.GetFirstItem(List2.List(tmpj)).Text), 10)
'              strTmpYear = Left(GetNotNull(doc.GetFirstItem(List2.List(tmpj)).Text), 4)
'           ElseIf List1.List(tmpj) = "备注" Then
'              rs.Fields(List1.List(tmpj)) = GetNotNull(doc.GetFirstItem(List2.List(tmpj)).Text) + "收文"
'           ElseIf List1.List(tmpj) = "年度" Then
'              rs.Fields(List1.List(tmpj)) = strTmpYear
'           Else
'              rs.Fields(List1.List(tmpj)) = GetNotNull(doc.GetFirstItem(List2.List(tmpj)).Text)
'           End If
'       Next
'       rs.Update
'
'       i = i + 1
'     End If
'
'     Set doc = view.GetNextDocument(doc)
'     DoEvents
'   End If
' Wend
'
'Call ShowGridEX1
'If rs.EOF And rs.BOF Then
'Else
'   rs.MoveFirst
'End If
''''''''''添加公文编号和题名到查询条件中
''Do While Not rs.EOF
''
''        If Not IsNull(rs!公文编号) Then
''          If rs!公文编号 <> "" Then
''          Combo2.AddItem rs!公文编号
''          End If
''        End If
''
''        If Not IsNull(rs!题名) Then
''         If rs!题名 <> "" Then
''           Combo4.AddItem rs!题名
''          End If
''
''        End If
''
''        rs.MoveNext
''Loop
'''''''''''''''''''''''''
'Exit Sub
'err_main:
'    MsgBox "系统连接数据库失败，可能是以下原因：" & _
'    Chr(13) & Chr(10) & _
'    "1、数据库服务没有启动！" & _
'    Chr(13) & Chr(10) & _
'    "2、数据库连接参数设置不正确！" & _
'    Chr(13) & Chr(10) & _
'    "3、网络连接不正确！" & _
'    Chr(13) & Chr(10) & _
'    Chr(13) & Chr(10) & _
'    "请检查无误后重新运行系统。" & _
'    Chr(13) & Chr(10) & Chr(13) & Chr(10) & "详细错误信息如下：" & Chr(13) & Chr(10) & "[" & Err.Number & "]" & Err.Description, vbInformation + vbOKOnly, "信息"
'End Sub
'Private Sub ShowGridEX1()
'    Dim rs As New ADODB.Recordset
'
'    rs.Open "Select * from 临时文书档案一文一件", Gcon_main, adOpenDynamic, adLockReadOnly
'    Set GridEX1.ADORecordset = rs
'    If GridEX1.Columns(GridEX1.Columns.count).Caption = "ID" Then GridEX1.Columns(GridEX1.Columns.count).Width = 0 '隐含ID
'
'End Sub
'Private Sub getMaxID()
'    Dim rs As New ADODB.Recordset
'    rs.Open "select max(ID) as maxid from " & txtswTable, Gcon_main, adOpenDynamic, adLockReadOnly
'    MaxID = rs.Fields("maxid")
'End Sub
'Public Function GetNotNull(O_value As Variant, Optional ByVal vtype As Integer = 2) As Variant
'Select Case vtype
'Case 1
'    GetNotNull = IIf(IsNull(O_value), 0, O_value)
'Case 2
'    GetNotNull = IIf(IsNull(O_value), "", O_value)
'Case 3
'    GetNotNull = IIf(IsNull(O_value), Now, O_value)
'End Select
'End Function
'
'
'Private Sub Form_Unload(Cancel As Integer)
'Me.Hide
'End Sub
'
'
'Private Sub mnuall_Click()
'Call ShowGridEX1
'End Sub
'
'