?? 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 + -