Funções Activex (VBScript + Ms. Outlook)

[mebkocznski 0]

Aí Pessoal,

 

Segue um código intessante que pode ajudar !!!!!!

 

Para criar estas funções será necessário criarmos uma OCX - Activex

 

Ao abrir o Visual Basic click em "File" --> "New Project"

 

E Selecionem a opção "Activex Control"

 

Renomeando Projeto

 

Click com o botão direito em cima do "Project1"

 

Em ProjectName coloquem o que achar melhor, mas não se esqueçam de não colocar acentos ou espaços.

 

Utilizarei o seguinte nome "OCX1"

 

Agora vamos renomear o UserControl1 , eu utilizarei "MyFunctions"

 

Diminua o tamanho do form criado para o mínimo possível

 

Feito Isto, precisaremos fazer referência a um objeto

 

"Microsoft Outlook 9.0 Object Library"

 

Agora é só criar as funções abaixo:

 

 

'Por: Marcelo Eduardo Barcello Kopczynski

'Data: 30/06/2003

'Objetivo: Chama janela de envio de mensagens do outlook, inserindo

'no corpo da mensagem o texto passado por parâmetro

 

Public Sub EmailOutlook(CorpoEmail As String)

Dim ObjOut As Outlook.Application

Set ObjOut = New Outlook.Application

Dim Msg As Outlook.MailItem

Set Msg = ObjOut.CreateItem(olMailItem)

 

Msg.Display

Msg.HTMLBody = CorpoEmail

Msg.Attachments.Add MontaArquivo(CorpoEmail, "html")

 

Set ObjOut = Nothing

Set Msg = Nothing

End Sub

 

 

'Por: Marcelo Eduardo Barcello Kopczynski

'Data: 30/06/2003

'Objetivo: Monta arquivo no lado do cliente com o texto e extensão desejada

 

Function MontaArquivo(Texto As String, extensao As String) As String

Dim Obj As Object

Dim OFile As Object

Set Obj = CreateObject("scripting.filesystemobject")

Set OFile = Obj.CreateTextFile("C:\arquivo." & extensao, True)

OFile.Write Texto

MontaArquivo = "C:\arquivo." & extensao

OFile.Close

Set OFile = Nothing

Set Obj = Nothing

End Function

 

'Por: Marcelo Eduardo Barcello Kopczynski

'Data: 30/06/2003

'Objetivo: Inclui uma nova Tarefa no Outlook do Cliente

 

Public Sub AgendaOutlook(Assunto As String, Lugar As String, Inicio As Date, CorpoMensagem As String)

Dim ObjOut As Outlook.Application

Set ObjOut = New Outlook.Application

Dim Msg As Outlook.AppointmentItem

Set Msg = ObjOut.CreateItem(olAppointmentItem)

 

Msg.Subject = Assunto & " - Advocacia On Line"

Msg.Importance = olImportanceHigh

Msg.Location = Lugar

Msg.Start = Inicio

Msg.End = DateAdd("n", 30, Inicio)

Msg.ReminderOverrideDefault = True

Msg.ReminderSet = True

Msg.ReminderMinutesBeforeStart = 30

Msg.Body = CorpoMensagem

Msg.Save

 

Set ObjOut = Nothing

Set Msg = Nothing

 

If Err <> 0 Then

MsgBox Err.Description

Else

MsgBox "Compromisso criado com sucesso em seu Microsoft Outlook", vbInformation

End If

End Sub

 

'Por: Marcelo Eduardo Barcello Kopczynski

'Data: 30/06/2003

'Objetivo: Inclui um novo contato no Outlook do Cliente

 

Sub CriaEnderecoOutlook(Razao_Social As String, E_Mail As String, Endereco As String, Cidade As String, Estado As String, Fax As String, Telefone As String)

Dim ObjOut As Outlook.Application

Set ObjOut = New Outlook.Application

Dim Msg As Outlook.ContactItem

Set Msg = ObjOut.CreateItem(olContactItem)

Msg.Email1Address = E_Mail

Msg.FullName = Razao_Social

Msg.BusinessAddressStreet = Endereco

Msg.BusinessAddressCity = Cidade

Msg.BusinessAddressState = Estado

Msg.BusinessFaxNumber = Fax

Msg.BusinessTelephoneNumber = Telefone

Msg.Save

Msg.Close olPromptForSave

Msg.Display 0

End Sub

 

Tudo Pronto agora vamos compilar a OCX........

 

Click em "File" --> Make "Ocx.MyFunctions"

 

Encontrando o CLSID

 

Agora precisamos saber qual o CLSID que foi gerado para esta "OCX"

 

Click em iniciar --> executar --> Digitem "RegEdit"

 

Aberto o editor de registro, agora vamos localizar nosso objeto

Clikc em "editar" --> Localizar

 

Procurem pelo nome do Objeto que vocês criaram , neste exemplo seria

OCX.MyFunctions

 

O valor que aparecer na Chave Principal é nosso CLSID

 

Para utilizarmos as funções na página desejada , basta criarmos um objeto e acessar seus métodos via VbScript

 

 

Criando o objeto na página

<OBJECT classid="CLSID:C083CB1C-7FCC-4A1A-BF72-  E4FC26B18CD4"   height=0   style="LEFT: 0px; TOP: 0px"   width=200   VIEWASTEXT   id="MyOcx">  </object>

E Agora o VbScript

 

<script Language="vbscript">Sub NovaMensagem(CorpoMensagem)MyOcx.EmailOutlook CorpoMensagemEnd Sub</script>

Lembrando à todos que para que esta OCX funcione corretamente, o Internet Explorer do Cliente deve estar com as opções de Executar e Instalar activex todas ativas.....

 

Falow !!!!

 

Até a próxima

[MAPSantos 0]

Tem como usar este codigo:'Por: Marcelo Eduardo Barcello Kopczynski'Data: 30/06/2003'Objetivo: Inclui uma nova Tarefa no Outlook do ClientePublic Sub AgendaOutlook(Assunto As String, Lugar As String, Inicio As Date, CorpoMensagem As String)Dim ObjOut As Outlook.ApplicationSet ObjOut = New Outlook.ApplicationDim Msg As Outlook.AppointmentItemSet Msg = ObjOut.CreateItem(olAppointmentItem)Msg.Subject = Assunto & " - Advocacia On Line"Msg.Importance = olImportanceHighMsg.Location = LugarMsg.Start = InicioMsg.End = DateAdd("n", 30, Inicio)Msg.ReminderOverrideDefault = TrueMsg.ReminderSet = TrueMsg.ReminderMinutesBeforeStart = 30Msg.Body = CorpoMensagemMsg.SaveSet ObjOut = NothingSet Msg = NothingIf Err <> 0 ThenMsgBox Err.DescriptionElseMsgBox "Compromisso criado com sucesso em seu Microsoft Outlook", vbInformationEnd IfEnd Subem ASP de forma a adicionar uma tarefa no Outlook?