📄 frmtmpwsda.frm
字号:
VERSION 5.00
Object = "{E684D8A3-716C-4E59-AA94-7144C04B0074}#1.1#0"; "GRIDEX20.OCX"
Begin VB.Form frmTmpWsda
Caption = "文档管理数据导入"
ClientHeight = 9180
ClientLeft = 60
ClientTop = 345
ClientWidth = 13785
LinkTopic = "Form1"
ScaleHeight = 9180
ScaleWidth = 13785
StartUpPosition = 2 '屏幕中心
WindowState = 2 'Maximized
Begin VB.Frame Frame1
Height = 600
Left = 120
TabIndex = 4
ToolTipText = "使用空格分隔关键词表示多个并列查询条件"
Top = 480
Width = 13455
Begin VB.CommandButton Command2
Caption = "退出"
Height = 360
Left = 12480
TabIndex = 9
Top = 180
Width = 855
End
Begin VB.ComboBox Combo2
Height = 300
Left = 1080
TabIndex = 8
Top = 180
Width = 3360
End
Begin VB.ComboBox Combo4
Height = 300
Left = 5040
TabIndex = 7
ToolTipText = "使用空格分隔关键词表示多个并列查询条件"
Top = 180
Width = 4710
End
Begin VB.CommandButton Command3
Caption = "查询"
Default = -1 'True
Height = 375
Left = 9840
TabIndex = 6
Top = 165
Width = 825
End
Begin VB.CommandButton Command4
Caption = "数据导入"
Height = 375
Left = 10800
TabIndex = 5
Top = 180
Width = 1545
End
Begin VB.Label Label2
Caption = "公文编号"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 120
TabIndex = 11
ToolTipText = "使用空格分隔关键词表示多个并列查询条件"
Top = 180
Width = 960
End
Begin VB.Label Label4
Caption = "题名"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 4560
TabIndex = 10
ToolTipText = "使用空格分隔关键词表示多个并列查询条件"
Top = 180
Width = 735
End
End
Begin VB.ListBox List1
Height = 240
Left = 120
TabIndex = 3
Top = 9240
Visible = 0 'False
Width = 2055
End
Begin VB.ListBox List2
Height = 240
Left = 2280
TabIndex = 2
Top = 9240
Visible = 0 'False
Width = 2055
End
Begin VB.ListBox List3
Height = 240
Left = 4560
TabIndex = 1
Top = 9240
Width = 1455
End
Begin VB.ListBox List4
Height = 240
Left = 6240
TabIndex = 0
Top = 9240
Width = 1455
End
Begin GridEX20.GridEX GridEX1
Height = 7695
Left = 120
TabIndex = 12
Top = 1440
Width = 13575
_ExtentX = 23945
_ExtentY = 13573
Version = "2.0"
AllowRowSizing = -1 'True
RecordNavigator = -1 'True
RecordNavigatorString= "文件:第|份，总文件数："
BoundColumnIndex= ""
ReplaceColumnIndex= ""
ScrollToolTipColumn= ""
MultiSelect = -1 'True
LockType = 1
Options = -1
RecordsetType = 1
AllowDelete = -1 'True
GroupByBoxVisible= 0 'False
RowHeaders = -1 'True
DataMode = 1
HeaderFontSize = 8.25
FontSize = 8.25
ColumnHeaderHeight= 270
IntProp1 = 0
IntProp2 = 0
IntProp7 = 0
ColumnsCount = 2
Column(1) = "frmTmpWsda.frx":0000
Column(2) = "frmTmpWsda.frx":00C8
FormatStylesCount= 6
FormatStyle(1) = "frmTmpWsda.frx":016C
FormatStyle(2) = "frmTmpWsda.frx":024C
FormatStyle(3) = "frmTmpWsda.frx":0390
FormatStyle(4) = "frmTmpWsda.frx":0440
FormatStyle(5) = "frmTmpWsda.frx":04F4
FormatStyle(6) = "frmTmpWsda.frx":05CC
ImageCount = 0
PrinterProperties= "frmTmpWsda.frx":0684
End
Begin VB.Label Label1
ForeColor = &H000000FF&
Height = 255
Left = 120
TabIndex = 13
Top = 120
Width = 2415
End
End
Attribute VB_Name = "frmTmpWsda"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim PublicNotesDb As New Domino.NotesDatabase
Dim doc As NotesDocument
Dim SourceNotesDb As NotesDatabase
Dim Sourceview As NotesView
Dim SourceDoc As NotesDocument
Dim tmpi As Variant
Dim tmpj As Integer
Dim view As NotesView
Dim MaxID As Long
Dim wdapp As Word.Application
Dim strTmpYear As String
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Dim tmpRS As New ADODB.Recordset
If Trim(Combo2.Text) = "" And Trim(Combo4.Text) = "" Then
MsgBox "条件输入不完整！", vbExclamation
Exit Sub
End If
Dim sqlstr As String
sqlstr = ""
If Combo2.Text <> "" Then
If sqlstr = "" Then
sqlstr = "文号 like '%" & Combo2.Text & "%'"
Else
sqlstr = sqlstr + "and 文号 like '% " & Combo2.Text & "%'"
End If
End If
If Combo4.Text <> "" Then
If sqlstr = "" Then
sqlstr = "题名 like '%" & Combo4.Text & "%'"
Else
sqlstr = sqlstr + "and 题名 like '%" & Combo4.Text & "%'"
End If
End If
tmpRS.Open "select * from 临时文书档案一文一件 where " + sqlstr, Gcon_main, adOpenDynamic, adLockOptimistic
Set GridEX1.ADORecordset = tmpRS
If GridEX1.Columns(GridEX1.Columns.count).Caption = "ID" Then GridEX1.Columns(GridEX1.Columns.count).Width = 0 '隐含ID
End Sub
Private Sub Command4_Click()
If GridEX1.SelectedItems.count = 0 Then
MsgBox "先选中要导入的纪录！", vbInformation + vbOKOnly, "信息"
Exit Sub
End If
If MsgBox("你想导入OA 文书档案 数据吗？" & Chr(13) & " 确定后请等待几分钟或更长时间....,否则取消退出.", vbQuestion + vbOKCancel, "信息") = vbCancel Then Exit Sub
Label1.Caption = "导入OA 文书档案 数据，请等待...."
Dim simTemp As JSSelectedItem
Dim RowData As JSRowData
Dim usql As String
For tmpi = 1 To GridEX1.RowCount
Set RowData = GridEX1.GetRowData(tmpi)
usql = RowData.Value(GridEX1.Columns("ID").Index) & ","
usql = Left(usql, Len(usql) - 1)
Dim rs1 As New ADODB.Recordset
Dim tmpRS As New ADODB.Recordset
tmpRS.Open "select * from 临时文书档案一文一件 where ID=" & usql, Gcon_main, adOpenDynamic, adLockReadOnly
Dim Pdwjrs As New ADODB.Recordset
Dim strSourcefilepath As String
Dim strSourceUrl As String
Dim strSourceDocid As String
Dim strPDWJDocid As String
Dim strPDWJfilepath As String
Dim Pdwjdoc As NotesDocument
Dim view As NotesView
Set PublicNotesDb = Session.GetDatabase(txtwsdaDominoServer, txtwsdaDominoDatabase)
Set view = PublicNotesDb.GetView("(Bydocid)")
'On Error GoTo Err3
Dim dc As NotesDocumentCollection
Dim tmpstr As String
Dim tmpdd As Object
'tmpdd = tmpRS.Fields("docid")
If tmpRS.Fields("docid") = Null Then
Else
tmpstr = tmpRS.Fields("DOCID") '得到临时数据库中存放的此文档的DOCID
Set doc = view.GetDocumentByKey(tmpstr, False) '通过DOCID在domino数据库中找到此文档
If doc Is Nothing Then
ElseIf doc.GetFirstItem("TagOflz") Is Nothing Then
'rs.Close
'If rs1.RecordCount > 0 Then
' rs1.Close
'Else
'End If
rs1.Open "select * from " & txtwsdaTable, Gcon_main, adOpenDynamic, adLockOptimistic
rs1.AddNew
For tmpj = 0 To List1.ListCount - 2
rs1.Fields(List1.List(tmpj)) = tmpRS.Fields(List1.List(tmpj))
Next
rs1.Update
Dim item As NotesItem
'''''''''''''''''处理源文档
'''''''''''''''''''''''''''''''''得到此文档的源文档,源文档在不同的数据库中
strSourcefilepath = doc.GetItemValue("Sourcefilepath")(0) '源文档数据库的路径
strSourceUrl = doc.GetItemValue("SourceUrl")(0) '源文档的全路径
strSourceDocid = Right(strSourceUrl, 32) '源文档的docid值
If doc.GetItemValue("ArchDate")(0) = "" Then
strTmpYear = "2004"
Else
strTmpYear = doc.GetItemValue("ArchDate")(0)
End If
If strSourcefilepath = "" Or strSourceDocid = "" Then
Else
Call DoDocument(strSourcefilepath, strSourceDocid)
End If
Gcon_main.Execute "delete from 临时文书档案一文一件 where ID=" & usql
''''在Domino库中，给相应的文档加上导出标记
Set item = doc.ReplaceItemValue("TagOflz", "ok")
Call doc.Save(True, True)
''''''''''''''''''''''''''''''''''''''''''''''end
'''''''''''''''''''源文档处理完毕
'''''''''''''''''''处理配对文件
If doc.GetItemValue("PDWJdocid")(0) = "" Then
Else
Dim pdwjItem As NotesItem
Dim v As Variant
Set pdwjItem = doc.GetFirstItem("PDWJdocid")
For Each v In pdwjItem.Values
Set Pdwjdoc = PublicNotesDb.GetDocumentByUNID(v)
If Pdwjdoc Is Nothing Then
strPDWJDocid = Right(Pdwjdoc.GetItemValue("SourceUrl")(0), 32)
strPDWJfilepath = Pdwjdoc.GetItemValue("Sourcefilepath")(0)
Call DoDocument(strPDWJfilepath, strPDWJDocid)
'Pdwjrs.Close
Pdwjrs.Open "select id from 临时文书档案一文一件 where docID= '" & strPDWJDocid & "'", Gcon_main, adOpenDynamic, adLockReadOnly
If Pdwjrs.EOF = False Then
Gcon_main.Execute "delete from 临时文书档案一文一件 where docID=" & strPDWJDocid
End If
Pdwjrs.Close
End If
''''在Domino库中，给相应的文档加上导出标记
Set item = Pdwjdoc.ReplaceItemValue("TagOflz", "ok")
Call Pdwjdoc.Save(True, True)
''''''''''''''''''''''''''''''''''''''''''''''end
Next
End If
'''''''''''''''''''配对文件处理完毕
rs1.Close
End If
'rs1.Cancel
' rs1.Close
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -