|
没测试环境,你看看: Public Const SW_HIDE = 0
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
'API functions to enumerate and set the
' desired forground window
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Declare Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
'This function will go through all windo
' ws currently running
'Once Lotus Notes window handle is found
' , it will make it the
'foreground window and exit the function
'
Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Boolean
Dim sSave As String, Ret As Long
Ret = GetWindowTextLength(hWnd)
sSave = Space(Ret)
GetWindowText hWnd, sSave, Ret + 1
If InStr(1, sSave, "Lotus Notes") > 0 Then
retval = SetForegroundWindow(hWnd)
Call ShowWindow(hWnd, SW_SHOWMAXIMIZED)
Exit Function
End If
'continue enumeration
EnumWindowsProc = True
End Function
'End Module Code Segment
'***************************************
'
'Begin "ThisDocument" Code Segment
'***************************************
'
Const cmdBarText = "Create Email Document"
Const cmdAction = "emailMe"
Const tagName = "EM"
Private Sub Document_Close()
On Error Resume Next
For i% = 1 To Application.CommandBars.Count - 1
If InStr(1, Application.CommandBars(i%).Name, "Create Mail Memo") > 0 _
Or InStr(1, Application.CommandBars(i%).Name, "Email") > 0 _
Or InStr(1, Application.CommandBars(i%).Name, "Email Document") > 0 _
Or InStr(1, Application.CommandBars(i%).Name, "Create Email Document") Then
ThisDocument.CommandBars(i%).Delete
ThisDocument.CommandBars(i%).Visible = False
End If
Next
Dim cmd As Office.CommandBarControl
Set cmd = Application.CommandBars.FindControl(Tag:=tagName)
Do While Not cmd Is Nothing
cmd.Delete
Set cmd = Application.CommandBars.FindControl(Tag:=tagName)
Loop
End Sub
Private Sub Document_New()
On Error Resume Next
For i% = 1 To Application.CommandBars.Count
If InStr(1, Application.CommandBars(i%).Name, "Create Mail Memo") > 0 _
Or InStr(1, Application.CommandBars(i%).Name, "Email") > 0 _
Or InStr(1, Application.CommandBars(i%).Name, "Email Document") > 0 _
Or InStr(1, Application.CommandBars(i%).Name, "Create Email Document") Then
ThisDocument.CommandBars(i%).Delete
ThisDocument.CommandBars(i%).Visible = False
End If
Next
Set eBut = ThisDocument.CommandBars.Add(Name:=cmdBarText)
With ThisDocument.CommandBars(cmdBarText)
.Position = msoBarTop
.Visible = True
End With
Set custBar = Application.CommandBars(cmdBarText).Controls.Add
With custBar
.Caption = cmdBarText
.Style = msoButtonCaption
.OnAction = cmdAction
.Tag = tagName
End With
End Sub
Private Sub Document_Open()
On Error Resume Next
For i% = 1 To Application.CommandBars.Count - 1
If InStr(1, Application.CommandBars(i%).Name, "Create Mail Memo") > 0 _
Or InStr(1, Application.CommandBars(i%).Name, "Email") > 0 _
Or InStr(1, Application.CommandBars(i%).Name, "Email Document") > 0 _
Or InStr(1, Application.CommandBars(i%).Name, "Create Email Document") Then
ThisDocument.CommandBars(i%).Delete
End If
Next
Set eBut = ThisDocument.CommandBars.Add(Name:=cmdBarText)
With ThisDocument.CommandBars(cmdBarText)
.Position = msoBarTop
.Visible = True
End With
Set custBar = Application.CommandBars(cmdBarText).Controls.Add
With custBar
.Caption = cmdBarText
.Style = msoButtonCaption
.OnAction = cmdAction
.Tag = tagName
End With
End Sub
Sub emailMe()
MsgBox ThisDocument.Application.Version
Dim WK As Object
Dim lnS As Object
Dim lnDB As Object
Dim lnDoc As Object
Dim lnDoc2 As Object
Dim lnRT As Object
Dim bd2 As Object
Dim cUNID As String
Dim file As String
If ActiveDocument.Saved = False Then
ActiveDocument.Save
End If
file = Word.ActiveDocument.FullName
Set lnS = CreateObject("Notes.NotesSession")
Set lnDB = lnS.GETDATABASE("", "")
Call lnDB.OPENMAIL
Set lnDoc = lnDB.createdocument
Set lnRT = lnDoc.createrichtextitem("Body")
With lnRT
Call .ADDNEWLINE(1)
Call .APPENDTEXT("This is a test")
Call .ADDNEWLINE(2)
Call .APPENDTEXT("Below is your attachment: " & file)
Call .ADDNEWLINE(1)
Call .APPENDTEXT(String(50, "-"))
Call .ADDNEWLINE(2)
End With
'Attach the file
Set bd2 = lnRT.EMBEDOBJECT(1454, "", file)
cUNID = lnDoc.UNIVERSALID
Call lnDoc.Save(True, True)
Set lnDoc2 = lnDB.GETDOCUMENTBYUNID(cUNID)
Set WK = CreateObject("Notes.NotesUIWorkspace")
Call WK.EDITDOCUMENT(True, lnDoc2)
Set WK = Nothing
Set lnS = Nothing
Set lnDB = Nothing
Set lnDoc = Nothing
Set lnDoc2 = Nothing
Set lnRT = Nothing
Set bd2 = Nothing
'Go through all processes (windows) unti
' l we get Lotus Notes
'Once we get LN Address, make it the act
' ive window
'The AddressOf operater id not supported
' in Office97
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
End Sub
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-7-26 10:32
楼主
