07/09/2004, 10:04
|
| | | Fecha de Ingreso: enero-2004
Mensajes: 23
Antigüedad: 20 años, 5 meses Puntos: 0 | |
Gracias chicos, consulto las páginas que me dicen y les aviso, les copio el código de VB: tiene 1 form, 2 módulos y 2 módulos de clase y las referencias y componentes del Groupwise
Código:
Form1:
Option Explicit
Private Sub Command1_Click()
If lstDisplayName.ListCount > 0 Then
Call groupwise
End If
lstDisplayName.Clear
lstDepartment.Clear
End Sub
Private Sub Form_Load()
Set MyRecipients = New Recipients
lstDisplayName.Clear
lstDepartment.Clear
End Sub
Private Sub groupwise()
On Error GoTo cmdSendMail_Click_Error
Dim MyRecipient As Recipient
Dim i As Integer
For i = 0 To lstDisplayName.ListCount - 1
MyRecipients.Add lstDisplayName.List(i)
Next
Dim usuarioactivo As String
Dim clavegroupwise As String
usuarioactivo = UCase(SystemLogonName)
'If isgSendMail(usuarioactivo, clavegroupwise, "mensaje", "asunto", "") Then
If isgSendMail(usuarioactivo, clavegroupwise, Trim("Envio de memo via groupwise" + " " + "Favor enviar respuesta al usuario del GroupWise: MemosMetro, para ver el archivo adjunto debe utilizar la aplicación Microsoft Word"), "Memo No. ", App.Path + "\memos.doc") Then
MsgBox "El mensaje ha sido enviado via GroupWise...", vbInformation
Set MyRecipients = Nothing
Set MyRecipients = New Recipients
End If
Exit Sub
cmdSendMail_Click_Error:
MsgBox Error$, vbInformation
End Sub
Private Sub GWab1_Click()
Call Update
End Sub
Private Sub Update()
Dim nCount As Integer
Dim sString As String
Dim nIndex As Integer
nCount = GWab1.TargetType(eTargetType_All)
For nIndex = 0 To nCount - 1
sString = GWab1.DisplayName(nIndex)
lstDisplayName.AddItem sString
sString = GWab1.Department(nIndex)
lstDepartment.AddItem sString
Next
End Sub
Módulo Basutilities:
Option Explicit
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Const HEX_BMP_KEY As String = "424D"
Public Const HEX_GIF_KEY As String = "4749"
Public Const HEX_JPG_KEY As String = "4A464946"
Public Const HEX_BYTE_SIZE As Long = 9
Public Const BLOCKSIZE = 32768
Sub CenterForm(frmForm As Form)
On Error GoTo CenterFormError
frmForm.Left = Screen.Width / 2 - frmForm.Width / 2
frmForm.Top = Screen.Height / 2 - frmForm.Height / 2
CenterFormContinue:
Exit Sub
CenterFormError:
MsgBox Error$, vbExclamation
Resume CenterFormContinue
End Sub
Function GetFileFromPath(sFilePath) As String
On Error GoTo GetFileFromPathError
Dim sFileTitle As String * 1024
Dim lRetVal As Long
lRetVal = GetFileTitle(sFilePath, sFileTitle, Len(sFileTitle))
GetFileFromPath = Mid(sFileTitle, 1, InStr(sFileTitle, Chr(0)) - 1)
GetFileFromPathContinue:
Exit Function
GetFileFromPathError:
MsgBox Error$, vbExclamation
Resume GetFileFromPathContinue
End Function
Function SystemLogonName() As Variant
On Error GoTo SystemLogonNameError
Dim sUserName As String
Dim lRetVal As Long
sUserName = String(2048, 32)
lRetVal = GetUserName(sUserName, Len(sUserName) - 1)
'See if there is no one logged in.
If InStr(sUserName, Chr(0)) > 0 Then
SystemLogonName = Mid(sUserName, 1, InStr(sUserName, Chr(0)) - 1)
Else
SystemLogonName = "Unknown"
End If
SystemLogonNameContinue:
Exit Function
SystemLogonNameError:
MsgBox Error$, vbExclamation
Resume SystemLogonNameContinue
End Function
Modulo1:
Option Explicit
Public gsRecipient As String
Public MyRecipients As Recipients
Public Declare Function RC Lib "c:\novell\groupwise\gwcma1.dll" _
Alias "DllRegisterServer" () As Long
Public Declare Function URC Lib "c:\novell\groupwise\gwcma1.dll" _
Alias "DllUnregisterServer" () As Long
Public GWApp As Application
Public GWRootAccount As Account
Public Const S_OK = &H0
Public Function isgSendMail(sUserID As String, sPassword As String, sMessage As String, sSubject As String, Optional sFilePath As String = "")
On Error GoTo isgSendMail_Error
Set GWApp = New Application
Dim MyFolder As Folder
Set GWRootAccount = GWApp.Login(sUserID, , sPassword)
Dim MyMessage As Message
Dim sFID As Variant
Dim MyRecipient As Recipient
'Determine wich folder will create the message normally Mailbox
isgSendMail = True
For Each MyFolder In GWApp.RootAccount.AllFolders
If MyFolder.Name = "Buzón" Then
'Return the folder ID
sFID = MyFolder.FolderID
Exit For
End If
Next
'Set the Folder with the Mailbox folder ID
Set MyFolder = GWRootAccount.GetFolder(sFID)
'Start message
Set MyMessage = MyFolder.Messages.Add
'Message Info
MyMessage.Subject = sSubject
MyMessage.BodyText = sMessage
'Optional Settings
MyMessage.FromText = "mensaje3"
'Loop through the objects to return the Email Addresses
For Each MyRecipient In MyRecipients
'USE THIS LINE FOR INTERNAL NAMEING LIKE JOHN DOE instead of [email protected]
'MyMessage.Recipients.Add MyRecipient.EmailAddress, "NGW", "egwTo"
MyMessage.Recipients.Add MyRecipient.EmailAddress
Next
If sFilePath <> "" Then
MyMessage.Attachments.Add sFilePath, egwFile, GetFileFromPath(sFilePath)
End If
MyMessage.Send
'MyMessage.Delete
Set MyMessage = Nothing
isgSendMail_Resume:
Exit Function
isgSendMail_Error:
isgSendMail = False
MsgBox Error$, vbInformation
Resume isgSendMail_Resume
End Function
Sub RegisterControlSub()
On Error GoTo E
If RC = S_OK Then
Else
End If
Exit Sub
E: MsgBox "Error: " & Err.Number & " " & Err.Description, vbCritical, ""
End Sub
Sub UnRegisterControlSub()
On Error GoTo U
If URC = S_OK Then
Else
End If
Exit Sub
U: MsgBox "Error: " & Err.Number & " " & Err.Description, vbCritical, ""
End Sub
Sub Main()
If App.PrevInstance Then
End
End If
Set MyRecipients = New Recipients
'RegisterControlSub
Form1.Show vbModal
End Sub
Modulo de clase Recipient:
Option Explicit
Public mvarEmailAddress As Variant
Public Property Let EmailAddress(vData As Variant)
mvarEmailAddress = vData
End Property
Public Property Get EmailAddress() As Variant
EmailAddress = mvarEmailAddress
End Property
Módulo de clase Recipients:
Option Explicit
Public mCol As Collection
Public Function Add(EmailAddress As Variant) As Recipient
Dim oRecipient As Recipient
Set oRecipient = New Recipient
oRecipient.EmailAddress = EmailAddress
mCol.Add oRecipient
Set Add = oRecipient
Set oRecipient = Nothing
End Function
Public Property Get Item(vntIndexKey As Variant) As Recipient
Set Item = mCol(vntIndexKey)
End Property
Public Property Get Count() As Long
Count = mCol.Count
End Property
Public Sub Remove(vntIndexKey As Variant)
Dim vItem As Recipient
Dim l As Long
l = 1
For Each vItem In mCol
If vItem.EmailAddress = vntIndexKey Then
mCol.Remove l
End If
l = l + 1
Next
End Sub
Public Property Get NewEnum() As IUnknown
Set NewEnum = mCol.[_NewEnum]
End Property
Private Sub Class_Initialize()
Set mCol = New Collection
End Sub
Private Sub Class_Terminate()
Set mCol = Nothing
End Sub
Y ese es todo el código, porfis si me pueden explicar mas o menos o logran pasarlo a dll les agradezco que me expliquen como, gracias
Última edición por NiñaC; 07/09/2004 a las 13:42
Razón: Colocar dentro de tag
|
