Rotina para retornar o diretório temporário do sistema operacional

UseLSX "*javacon"

Function getTempDirectory() As String
   
    On Error GoTo trataerro
   
    Dim t_sesJava As New JavaSession
    Dim t_clsFile As JavaClass
    Set t_clsFile = t_sesJava.GetClass("java/io/File")
    Dim t_mthCreateTemp As JavaMethod
    Set t_mthCreateTemp = t_clsFile.GetMethod("createTempFile", "(Ljava/lang/String;Ljava/lang/String;)Ljava/io/File;")
    Dim t_hflFile As JavaObject
   
    Set t_hflFile = t_mthCreateTemp.Invoke(, "tdoc_dir", ".tmp")
   
    Dim strParent As String
   
    strParent = strLeftBack(t_hflFile.getPath(),"\")
   
 
    If InStr(strParent, "/") <> 0 And Right(strParent, 1) <> "/" Then strParent = strParent & "/"
    If InStr(strParent, "\") <> 0 And Right(strParent, 1) <> "\" Then strParent = strParent & "\"
   
    getTempDirectory = strParent
   
   
    Exit Function
trataerro:
    Call AddToStackTrace()
End Function

Remover hide-when de documentos com campo richtext utilizando xsl

Option Public
Option Declare

Const CONST_XSL = {

   

   
   
       
           
       
   
   
   
   
 }
Sub Initialize
    On Error GoTo ErrorHandler
   
    Dim S As New NotesSession
    Dim t_dbThis As NotesDatabase
    Set t_dbThis = S.Currentdatabase
   
    Dim t_nstXSLT As NotesStream
    Set t_nstXSLT = S.CreateStream()
    'Call t_nstXSLT.Open("c:\dados\removehiderichtext.xsl", "UTF-8")
   
    Call t_nstXSLT.Writetext(CONST_XSL)
    t_nstXSLT.Position = 0
   
    Dim t_ndeSource As NotesDXLExporter
    Set t_ndeSource = S.Createdxlexporter()
    Dim t_nclSource As NotesNoteCollection
    Set t_nclSource = t_dbThis.Createnotecollection(false)
    t_nclSource.Selectdocuments = True
    '// REALIZEI UM FILTRO PARA OS DOCUMENTOS COM O FORMULÁRIO QUE DESEJO ALTERAR
    t_nclSource.Selectionformula = |@Contains(@LowerCase(Form);"fo_docrichtext")|
    Call t_nclSource.BuildCollection()
    Call t_ndeSource.setInput(t_nclSource)
   
    Dim t_ndiDest As NotesDXLImporter
    Set t_ndiDest = S.Createdxlimporter()
    Call t_ndiDest.setOutput(t_dbThis)

    t_ndiDest.Documentimportoption= DXLIMPORTOPTION_REPLACE_ELSE_IGNORE
   
    Dim t_xslTransformer As NotesXSLTransformer
    Set t_xslTransformer = S.Createxsltransformer()
    Call t_xslTransformer.SetStyleSheet(t_nstXSLT)
   
    Call t_ndeSource.Setoutput(t_xslTransformer)
    Call t_ndiDest.Setinput(t_xslTransformer)
   
    Call t_ndeSource.Process()   

    Exit Sub
ErrorHandler:
    Dim t_strError As String
    t_strError = Error & ": " & Err()
    MsgBox t_strError
   
    If Not t_ndeSource Is Nothing Then
        Dim t_nosError As NotesStream
        Set t_nosError = S.Createstream()
        Call t_nosError.open("C:\dados\Error.xml", "UTF-8")
        Call t_nosError.Writetext(t_ndeSource.Log)
        Call t_nosError.Close()
    End If
    Exit sub
End Sub

Exporta documento para dxl, redefine a margem do campo richtext , removendo alguns valores para impressão

Option Declare
Use "OpenLogFunctions"

Sub Initialize

On Error GoTo trataerro

Dim sesSessao As New NotesSession
Dim bdCorr As NotesDatabase
Set bdCorr=sesSessao.CurrentDatabase

Dim dc As NotesDocumentCollection
Set dc=bdCorr.UnprocessedDocuments

Dim cont As Integer
cont=dc.Count

If cont=1 Then

Dim docAssis As NotesDocument
Set docAssis=dc.GetFirstDocument

Dim dxExporter As NotesDXLExporter
Dim dxImporter As NotesDXLImporter
Set dxExporter = sesSessao.Createdxlexporter
Set dxImporter = sesSessao.Createdxlimporter

Call dxExporter.setInput(docAssis)

Call dxImporter.setoutput(bdCorr)
dxImporter.Designimportoption = DXLIMPORTOPTION_CREATE
dxImporter.Documentimportoption = DXLIMPORTOPTION_CREATE

Dim t_xslTransformer As NotesXSLTransformer
Set t_xslTransformer = sesSessao.Createxsltransformer()
Dim t_istXSLT As NotesStream
Set t_istXSLT = sesSessao.Createstream()

Dim strStyleXML As String
strStyleXML = {








S






6.8743in















fo_cadAssisImp






}

Call t_istXSLT.Writetext(strStyleXML)
Call t_xslTransformer.Setstylesheet(t_istXSLT)

Call dxExporter.Setoutput(t_xslTransformer)
Call dxImporter.Setinput(t_xslTransformer)

Call dxExporter.Process()

Dim strNoteID As String
strNoteID = dxImporter.Getfirstimportednoteid()

Dim docAssisImp As NotesDocument
Set docAssisImp = bdCorr.Getdocumentbyid(strNoteID)

If docAssisImp Is Nothing Then
MsgBox "O sistema não conseguiu processar a impressão. Por favor, contate um administrador do sistema."
Exit Sub
End If

Call sesSessao.SetEnvironmentVar("ASSISTECEXPORTACAO", "I")

Dim ws As New NotesUIWorkspace
Call ws.DialogBox("fo_cadAssisImp", False, False, True, True, True, True, "Impressão de Assistência Técnica", docAssisImp, False, True, True)

Exit Sub
End If
Msgbox "Você deve selecionar um documento para impressão!"
Exit Sub
trataerro:
Call LogError()
Exit Sub
End Sub

Exportar documento para dxl

Sub Click(Source As Button)
   
    On Error Goto error_handler
   
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Set db = session.CurrentDatabase
   
    Dim col As NotesDocumentCollection
    Set col = db.UnprocessedDocuments
    Dim docselecionado As NotesDocument
    Set docselecionado = col.GetFirstDocument
   
    If docselecionado Is Nothing Then
        Msgbox |docselecionado não selecionado|
        Exit Sub
    End If
   
   
    Dim stream         As NotesStream
    Set stream         = session.CreateStream
    Dim exporter         As NotesDXLExporter
    Dim FILENAME     As String
   
    FILENAME = "c:\dados\dxlDocumento.xml"
    If Not stream.Open ( FILENAME ,"UTF-8") Then
        Messagebox "Cannot open " & FILENAME,, "Error"
        Exit Sub
    End If
   
    Call stream.Truncate
   
    Set exporter = session.CreateDXLExporter
    Call exporter.SetInput ( docselecionado )
    Call exporter.SetOutput ( stream )
    Call exporter.Process
   
   
   
    Exit Sub
error_handler:
    Msgbox |Erro na linha: | & Cstr(Erl) & | Tipo: | & Cstr(Err) & | | & Cstr(Error),16,|Error|
    Exit Sub
End Sub

Descompactar arquivos zip em Lotus Script utilizando LS2J

Como Lotus Script não possui uma classe nativa para compactar () ou descompactar arquivos no formato '.zip', Criei essa funcionalidade utilizando 'ls2j' para conectar na classe java.


Necessidade: Extrair o arquivo compactado do campo richtext e exibir o arquivo 'Player.html'.


1º Criação de um agent Lotus Script com o código abaixo:


Option Public
Option Declare
UseLSX "*javacon"
Use "bib_unZip"

Sub Initialize
On Error GoTo trataerro

Dim ses_Sessao As New NotesSession
Dim ws_AreaTrabalho As New NotesUIWorkspace
Dim rti_anexos As NotesRichTextItem
Dim doc_Anexo As NotesDocument

Dim strCaminho As String
Dim strNomeAnexoZip As String
 
Set doc_Anexo = ws_AreaTrabalho.Currentdocument.Document

Set rti_anexos = doc_Anexo.Getfirstitem("ca_AnexoConvertido")

If  Not rti_anexos Is Nothing Then
If ( rti_anexos.Type = RICHTEXT ) Then
If Not IsEmpty( rti_anexos.EmbeddedObjects ) Then

strCaminho = Environ("temp")
strCaminho = MkDir(strCaminho + "\" + doc_Anexo.Universalid)

ForAll Anexo In rti_Anexos.EmbeddedObjects
If Anexo.Type = EMBED_ATTACHMENT Then
Call Anexo.ExtractFile(strCaminho & Anexo.Source)
strNomeAnexoZip = Anexo.Source
End If
End ForAll
Else
MsgBox |Documento não possui anexo convertido!|,64,|Operação Cancelada|
Exit Sub
End If
End If
End If

Dim strFullPathZip As String
strFullPathZip = strCaminho & strNomeAnexoZip


If strNomeAnexoZip = "" Then
MsgBox |Documento não possui anexo convertido!|,64,|Operação Cancelada|
Kill strFullPathZip
Exit sub
End If

Dim strExtensaoAnexo As String
strExtensaoAnexo = |.|&LCase(StrRightBack(CStr(strNomeAnexoZip), "."))

If (strExtensaoAnexo <> ".zip" )Then
MsgBox |Arquivo convertido contem arquivos inválidos!|,64,|Operação Cancelada|
Kill strFullPathZip
Exit Sub
End If


Dim mySession As JavaSession
Dim zipClass As JavaClass 
Dim zipFileObject As JavaObject

Set mySession = New JavaSession()
Set zipClass = mySession.GetClass("br.com.unzip.controller.UnZip")
Set zipFileObject = zipClass.CreateObject()

Call zipFileObject.ziparArquivo(strFullPathZip)


Dim returnZipExtractFolder As String

returnZipExtractFolder =   zipFileObject.getDestinationFolder() 


If Trim(returnZipExtractFolder)="" Then
Error 1001,|Não foi possível descompactar o arquivo :  | & strFullPathZip
Exit Sub
End If

Dim intRespostaShell As Integer
intRespostaShell = Shell("explorer " & returnZipExtractFolder & "\Player.html",1)



Exit Sub
trataerro:
MsgBox "Aconteceu um erro inesperado, favor, contactar o administrador!",16,"Operação Cancelada!"
Call logError()
Exit sub
End Sub



2º Criação da biblioteca de script 'bib_UnZip'  em Java com os métodos p/compactar.

Classe Progresso.  => Progressive dialog


package br.com.unzip.view;

import java.awt.Window;
import java.awt.event.WindowAdapter;
import java.awt.event.WindowEvent;
import java.awt.event.WindowListener;

import javax.swing.JFrame;
import javax.swing.ProgressMonitor;

public class Progresso {

ProgressMonitor progress;

public Progresso(String strMensagem, String strAlerta, int intMaximo){
JFrame frame = new JFrame();
WindowListener exitListener;

exitListener = new WindowAdapter() {
public void windowClosing(WindowEvent e) {
Window window = e.getWindow();
window.setVisible(false);
window.dispose();
System.exit(0);
}
};
frame.addWindowListener(exitListener);

progress = new ProgressMonitor(frame, strMensagem, strAlerta, 0, intMaximo);
}

public void setProgresso(int intProgresso){
progress.setProgress(intProgresso);
}

public boolean cancelado(){
return progress.isCanceled();
}
}


Classe  model => descompactar os arquivos


package br.com.unzip.model;

import java.io.File;
import java.io.FileInputStream;
import java.io.FileOutputStream;
import java.io.IOException;
import java.util.zip.ZipEntry;
import java.util.zip.ZipInputStream;

public class UnZipFile {


/**
     * Unzip it
     * @param zipFile input zip file
     * @param output zip file output folder
     */
    public void unZipIt(String zipFile, String outputFolder){

     byte[] buffer = new byte[1024];

     
     try{

    //create output directory is not exists
    File folder = new File(outputFolder);
    if(!folder.exists()){
    folder.mkdir();
    }

    //get the zip file content
    ZipInputStream zis = new ZipInputStream(new FileInputStream(zipFile));
   
   
    //get the zipped file list entry
    ZipEntry ze = zis.getNextEntry();
   
    while(ze!=null){

      String fileName = ze.getName();
           File newFile = new File(outputFolder + File.separator + fileName);

           System.out.println("file unzip : "+ newFile.getAbsoluteFile());

            //create all non exists folders
            //else you will hit FileNotFoundException for compressed folder
            new File(newFile.getParent()).mkdirs();

            FileOutputStream fos = new FileOutputStream(newFile);             

            int len;
            while ((len = zis.read(buffer)) > 0) {
        fos.write(buffer, 0, len);
            }

            fos.close();   
            ze = zis.getNextEntry();
    }

        zis.closeEntry();
    zis.close();

    }catch(IOException ex){
       ex.printStackTrace(); 
    }
   }    
}


Classe  UnZip => principal

package br.com.unzip.controller;

import java.text.SimpleDateFormat;
import java.util.Date;

import br.com.unzip.model.UnZipFile;

public class UnZip {

private String destinationFolder = null;

public UnZip(){
}

public void ziparArquivo(String caminhoArquivoZip) {

String sourceFolder = "";

sourceFolder = caminhoArquivoZip;

if(sourceFolder != null){

destinationFolder = System.getProperty("java.io.tmpdir");

Date data = new Date();
SimpleDateFormat dateFormat = new SimpleDateFormat("ddMMyyyy-HHmmss"); 
destinationFolder = destinationFolder + dateFormat.format(data); 
System.out.println("destinationFolder: " + destinationFolder);
UnZipFile zipFolder = new UnZipFile();
zipFolder.unZipIt(sourceFolder, destinationFolder);
}
}

public String getDestinationFolder() {
return destinationFolder;
}
}

Zipar arquivos em Lotus Script com ls2j

Como Lotus Script não possui uma classe nativa para compactar arquivos no formato '.zip', Criei essa funcionalidade utilizando 'ls2j' para conectar na classe java.

Necessidade: O sistema deverá permitir a seleção de um arquivo no formato 'player.html' e o sistema deverá compactar toda a estrutura de diretórios do arquivo selecionado.


1º Criação de um agent Lotus Script com o código abaixo:



Option Public
Option Declare
UseLSX "*javacon"
Use "bib_zip"
Use "OpenLogFunctions" '// OpenLog para captura de erros 
Sub Initialize
On Error GoTo trataerro

Dim mySession As JavaSession
Dim zipClass As JavaClass 
Dim zipFileObject As JavaObject

Set mySession = New JavaSession()
Set zipClass = mySession.GetClass("br.com.zipFile.controller.ZiparArquivos")
Set zipFileObject = zipClass.CreateObject()

Dim ses_corrente As New NotesSession
Dim strDesktop As String

strDesktop  = getDiretorio(ses_corrente)

Dim ws_corrente As New NotesUIWorkspace
Dim varArqHtml As Variant

varArqHtml = ws_corrente.OpenFileDialog(False, "Selecione o arquivo 'Player.html' para anexar", "Htm|*.html", strDesktop)

If IsEmpty(varArqHtml) Then
MsgBox "Operação Cancelada"
Exit Sub
End If

Dim strArqHtmlDiretorio As String
Dim strArqHtmlNomeDir As String
strArqHtmlDiretorio = varArqHtml(0)

strArqHtmlDiretorio = StrLeftBack(strArqHtmlDiretorio,"\")
strArqHtmlNomeDir = StrRightBack(strArqHtmlDiretorio,"\")

Call zipFileObject.ziparArquivo(strArqHtmlDiretorio,strArqHtmlNomeDir)

Dim returnZipPath As String

returnZipPath =   zipFileObject.getZippedFilePath()  

Dim iuD_corrente As NotesUIDocument
Set iuD_corrente = ws_corrente.currentDocument
Dim doc_atual As NotesDocument
Set doc_atual = iuD_corrente.Document

' //define o campo como notesrichtextitem p/poder anexar
Dim rti_anexo As NotesRichTextItem

set  rti_anexo = doc_atual.Getfirstitem("ca_AnexoConvertido")

If Not rti_anexo Is Nothing Then
Call rti_anexo.Remove()
End If

Set rti_anexo = New NotesRichTextItem(doc_atual, "ca_AnexoConvertido")

Call  rti_anexo.EmbedObject( EMBED_ATTACHMENT, "", returnZipPath)
Call doc_atual.Save(True,False)
doc_atual.SaveOptions = "0"
Call iuD_corrente.Close()
Call ws_corrente.editDocument(True,doc_atual,False)

Exit Sub
trataerro:
MsgBox | Erro na linha | & CStr(Erl) & | tipo | & CStr(Err) & |   |  & CStr(Error) , 16, |Operação Cancelada|
Call LogError()
Exit Sub
End Sub

Function getDiretorio(ses_session As NotesSession) As String

On Error GoTo trataerro

getDiretorio = ""

Dim strAux As String

strAux = Environ("HomePath")
If (Trim(strAux)<>"") Then
getDiretorio = strAux + |\Desktop|
Exit  Function
End If

strAux = Environ("HOMEDRIVE")
If (Trim(strAux)<>"") Then
getDiretorio = strAux
Exit  Function
End If

strAux = ses_session.GetEnvironmentString("Directory",True)
If (Trim(strAux)<>"") Then
getDiretorio = strAux
Exit  Function
End If

strAux = ses_session.GetEnvironmentString("Location",True)
If (Trim(strAux)<>"") Then
getDiretorio = strAux
Exit  Function
End If

trataerro:
Call AddtoStackTrace()
End Function

2º Criação da biblioteca de script 'bib_zip'  em Java com os métodos p/compactar.

Classe Progresso.  => Progressive dialog


package br.com.zipFile.view;

import java.awt.Window;
import java.awt.event.WindowAdapter;
import java.awt.event.WindowEvent;
import java.awt.event.WindowListener;

import javax.swing.JFrame;
import javax.swing.ProgressMonitor;

public class Progresso {

ProgressMonitor progress;

public Progresso(String strMensagem, String strAlerta, int intMaximo){
JFrame frame = new JFrame();
WindowListener exitListener;

exitListener = new WindowAdapter() {
public void windowClosing(WindowEvent e) {
Window window = e.getWindow();
window.setVisible(false);
window.dispose();
System.exit(0);
}
};
frame.addWindowListener(exitListener);

progress = new ProgressMonitor(frame, strMensagem, strAlerta, 0, intMaximo);
}
public void setProgresso(int intProgresso){
progress.setProgress(intProgresso);
}
public boolean cancelado(){
return progress.isCanceled();
}
}

Classe  model => compactar os arquivos


package br.com.zipFile.model;

import java.io.File;
import java.io.FileInputStream;
import java.io.FileOutputStream;
import java.io.IOException;
import java.util.ArrayList;
import java.util.List;
import java.util.zip.ZipEntry;
import java.util.zip.ZipOutputStream;

import br.com.zipFile.view.Progresso;

public class ZipFolder {

List fileList;
private String sourceFolder = "";

public ZipFolder(String sourceFolder){
this.sourceFolder = sourceFolder;
fileList = new ArrayList(); 
}

public void zipIt(String zipFile){

byte[] buffer = new byte[1024];
Progresso progresso = new Progresso("Compactando arquivos...", "Aguarde...", fileList.size()-1);
   int counter = 0;
try{
FileOutputStream fos = new FileOutputStream(zipFile);
ZipOutputStream zos = new ZipOutputStream(fos);

for(String file : this.fileList){
ZipEntry ze= new ZipEntry(file);
zos.putNextEntry(ze);
FileInputStream in = new FileInputStream(sourceFolder + File.separator + file);

int len;
while ((len = in.read(buffer)) > 0) {
zos.write(buffer, 0, len);
}

if(progresso.cancelado()){
break;
}

progresso.setProgresso(counter);
counter++;
in.close();
}

zos.closeEntry();
zos.close();

}catch(IOException ex){
ex.printStackTrace();   
}
}

public void generateFileList(File node){
//add file only
if(node.isFile()){
fileList.add(generateZipEntry(node.getAbsoluteFile().toString()));
}

if(node.isDirectory()){
String[] subNote = node.list();
for(String filename : subNote){
generateFileList(new File(node, filename));
}
}
}

private String generateZipEntry(String file){
return file.substring(sourceFolder.length()+1, file.length());
}
}

Classe  ZiparArquivos => principal


package br.com.zipFile.controller;

import java.io.File;
import java.text.SimpleDateFormat;
import java.util.Date;

import br.com.zipFile.model.ZipFolder;

public class ZiparArquivos {

private String destinationFileName = null;

public ZiparArquivos(){
}

public void ziparArquivo(String caminhoArquivoHtml,String arquivoHtml) {

String sourceFolder = "";
String destinationFolder = "";
sourceFolder = caminhoArquivoHtml;

if(sourceFolder != null){
destinationFolder = System.getProperty("java.io.tmpdir");
Date data = new Date();
SimpleDateFormat dateFormat = new SimpleDateFormat("ddMMyyyy-HHmmss"); 
destinationFileName = destinationFolder + arquivoHtml + "_" + dateFormat.format(data) + ".zip"; 
ZipFolder zipFolder = new ZipFolder(sourceFolder);
zipFolder.generateFileList(new File(sourceFolder));
zipFolder.zipIt(destinationFileName);
}
}
public String getZippedFilePath(){
return destinationFileName;
}
}

Buscando informações no Names com ajax e json

1º Criar a bilbioteca de javascript de  Ajax

#############################################################################

function AJAX(url, metodo, params, processa, modo) {
 this.url = url;
 this.metodo = (metodo)? metodo : 'GET';
 this.params = (metodo='GET')? null : params;
 this.processaresultado = processa;
 this.modo = (modo) ? modo : 'T';
 if(this.modo!='T' && this.modo!='X'){
  this.modo='T';
 }
 this.conectar();
}

AJAX.prototype = {
conectar: function() {
  if(this.url==undefined || this.url==''){
   return;
  }
  this.httprequest = null;
  if (window.XMLHttpRequest){
  this.httprequest = new XMLHttpRequest();
  if(this.metodo=='POST')
   this.httprequest.setRequestHeader('Content-length', params.length );
  } else if (window.ActiveXObject) {
   try {
    this.httprequest = new ActiveXObject("Msxml2.XMLHTTP");
   } catch(e){
    try{
     this.httprequest = new ActiveXObject("Microsoft.XMLHTTP");
    } catch(e) {}
   }
  }
  if(this.httprequest!=null && this.httprequest!=undefined) {
   var obj = this;
   this.httprequest.onreadystatechange = function() {
    obj.processaretorno.call(obj);
   }
   this.httprequest.open(this.metodo,this.url,true);
   this.httprequest.send(this.params);
  }
 },
processaretorno : function(){
  if(this.httprequest.readyState==4){
   if(this.httprequest.status==200) {
    var resp = (this.modo=='T')? this.httprequest.responseText : this.httprequest.responseXML;
    if(this.processaresultado!=null){
     this.processaresultado(resp);
    } else {
     document.write(resp);
    }
   } else {
    this.processaerro();
   }
  }
 },
processaerro: function() {
  alert(this.httprequest.status + ' - ' + this.httprequest.statusText + ' :-> ' + this.url);
 }
}
function getHash() {
 return new Date().getTime();
}
##############################################################################

2º  Criar função que executara a chamada do agente lotusscript/java para realizar a consulta e criar o objeto Json


##############################################################################


//Busca dados por Chave
function buscaDadosPorChave(chave,t_funcao){
// S => solicitante
// B => beneficiario

if(chave == null) return;

if(chave.length != 4){
alert("A chave " + chave + " é inválida. A chave deverá conter 4 dígitos.");
return false;
}else{
var tdoc = new TDocument();
var ajax = new AJAX();
vurl = "http://"+ tdoc.server+ "/" + tdoc.pathname +"/ag_BuscaDadosporChaveWeb?OpenAgent&chave="+chave+"&hash="+getHash();
ajax.url = vurl;
ajax.modo = 'T';
ajax.metodo ="GET"
ajax.processaresultado = t_funcao
ajax.conectar();
}
}
//Fim da Busca por Chavee

##############################################################################

3º criação do agente p/buscar as informações no Names/base de informações de usuário


Sub Initialize
On Error GoTo error_handler

Dim m_Session As New NotesSession
Dim m_docContext As NotesDocument

Set m_docContext = m_Session.DocumentContext

Dim t_strChave As String
t_strChave = f_retornaParametroURL (m_docContext.Query_String(0),"chave")

Dim m_docPerson As NotesDocument
Set m_docPerson = getDocPersonNames(t_strChave)


'cria o objeto json
Print "Content-type: text/html;charset=utf-8"
Print "{"

If m_docPerson Is Nothing Then
Print |"localizado":"0",|
Print |"chave":"não encontrado",|
Print |"nomenotes":"não encontrado",|
Print |"orgao":"não encontrado",|
Print |"ramal":"não encontrado",|
Print |"matricula":"não encontrado",|
Print |"identificacao":"não encontrado",|
Print |"situacaocontratual":"não encontrado",|
Print |"funcao" :"não encontrado"|
Else
Dim t_name As NotesName
Set t_name = New NotesName(m_docPerson.ca_nomeNotes(0))

Set nome = New NotesName(m_docPerson.FullName(0))
Print |"localizado":"1",|
Print |"chave":"|+ EscapeJS(m_docPerson.ca_chave(0)) +|",|
Print |"nomenotes":"|+ EscapeJS(t_name.Abbreviated) +|",|
Print |"orgao":"|+ EscapeJS(m_docPerson.ca_orgaoMenor(0))+|",|
Print |"ramal":"| + EscapeJS(m_docPerson.ca_ramalSITEL(0))+|",|
Print |"matricula":"| + EscapeJS(m_docPerson.ca_matricula(0))+|",|
Print |"identificacao":"| + EscapeJS(m_docPerson.ca_identificacao(0))+|",|
Print |"situacaocontratual":"| + EscapeJS(retornaVinculo(m_docPerson.ca_vinculo(0)))+|",|
Print |"regiao":"|+ EscapeJS(m_docPerson.ca_regiao(0))+|",|
Print |"funcao":"| + EscapeJS(m_docPerson.ca_funcao(0))+|"|

End If

Print "}"

Exit Sub

Error_Handler:
'Print||
Print {}
Call LogError()
Exit sub
End Sub

Function f_retornaParametroURL(ByVal t_qry As String,ByVal t_param As String ) As String
On Error GoTo trataerro

Dim i,j As Integer
Dim result As String
i = InStr(1, t_qry, t_param)
result= ""
If i > 0 Then
j = InStr(i, t_qry, "&")
If j > 0 Then
result$ = Mid(t_qry, i + Len(t_param) + 1, (j - 1) - (i + Len(t_param)))
Else
result$ = Mid(t_qry, i + Len(t_param) + 1)
End If
End If
f_retornaParametroURL = result

trataerro:
Call AddToStackTrace()
End Function




Function EscapeJS(ByVal a_strOrigem As String) As String
On Error GoTo ErrorHandler
Dim t_astrBusca(0 To 1) As String
t_astrBusca(0) = |\|
t_astrBusca(1) = |"|
Dim t_astrSubst(0 To 1) As String
t_astrSubst(0) = |\\|
t_astrSubst(1) = |\"|

Dim t_astrSource(0 To 0) As String
t_astrSource(0) = a_strOrigem

Dim t_astrRet As Variant
t_astrRet = Replace(t_astrSource, t_astrBusca, t_astrSubst)

EscapeJS = t_astrRet(0)

Exit Function
ErrorHandler:
Call AddToStackTrace()
End Function



##############################################################################

4 º Função para popular o documento web.

function atualizaCamposSolicitante(txt){

var obj = eval ("(" + txt + ")");

if (obj.localizado == '0') {
alert('Chave não encontrada na base de pessoal.\nFavor informar a chave correta.');
document.getElementById("ca_PEDSolicitanteLocalizado").value = "0";
}else{
document.getElementById("ca_PEDSolicitanteLocalizado").value = "1";
}

document.getElementById("PEDsolicitanteTX").value = obj.nomenotes;
document.getElementById("PEDsolicitantelotacaoTX").value = obj.orgao;
document.getElementById("PEDsolicitanteramalTX").value = obj.ramal;
document.getElementById("PEDfuncaoTX").value = obj.funcao;


}

function atualizaCamposBeneficiario(txt){

var obj = eval ("(" + txt + ")");

if (obj.localizado == '0') {
alert('Chave não encontrada na base de pessoal.\nFavor informar a chave correta.');
document.getElementById("ca_PEDbeneficiarioLocalizado").value = "0";
}else{
document.getElementById("ca_PEDbeneficiarioLocalizado").value = "1";
}

document.getElementById("ca_PEDbeneficiarioNomeTX").value = obj.nomenotes;
document.getElementById("ca_PEDbeneficiarioNomeTX").value = obj.nomenotes;
document.getElementById("ca_PEDbeneficiarioUnidadeTX").value = obj.orgao;
document.getElementById("ca_PEDbeneficiarioCargoTX").value = obj.funcao;
document.getElementById("ca_PEDbeneficiarioRamalTX").value = obj.ramal;
document.getElementById("ca_PEDbeneficiarioRegiaoTX").value = obj.regiao;
document.getElementById("ca_PEDbeneficiarioMatriculaTX").value = obj.matricula;
document.getElementById("ca_PEDbeneficiarioIdentificadorTX").value = obj.identificacao;
document.getElementById("ca_PEDbeneficiarioSContratualTX").value = obj.situacaocontratual;

}


##############################################################################
5º Chamada da ação
'// do exemplo ficou no evento onBlur
'// informa a chave e a funcao desejada

buscaDadosPorChave(this.value,funcao)

##############################################################################

LotusScript code to embed a picture into a Notes richtext item

Follows a simple LotusScript function that will embed a file system picture (strFilePath As String) into the Body RichText field of a Notes document (doc As NotesDocument). This will not embed as an icon, but as the image itself.
Function EmbedPictureIntoRichText(doc As NotesDocument, strFilePath As String) As Boolean

EmbedPictureIntoRichText = False

Dim session As New NotesSession
Dim db As NotesDatabase
Dim body As NotesMIMEEntity
Dim header As NotesMIMEHeader
Dim child As NotesMIMEEntity
Dim stream As NotesStream
Dim fileFormat As String
Dim rtitemA As NotesRichTextItem
Dim rtitemB As NotesRichTextItem

Set db = doc.Parentdatabase
Set stream = session.CreateStream
Call stream.Open(strFilePath)
Set body = doc.CreateMIMEEntity("DummyRichText")
Set header = body.CreateHeader("Content-Type")
Call header.SetHeaderVal("multipart/mixed")
Set child = body.CreateChildEntity() 'Set childEntity = richTextItemObj.CreateChildEntity()
fileFormat = "image/jpeg" 'Other formats are "image/gif" "image/bmp"
Call child.Setcontentfrombytes(stream, fileFormat, 1730)
Call stream.Close()
Call doc.save(false, false) 'JUST TO REFRESH

Set rtitemA = doc.GetFirstItem("Body")
Set rtitemB = doc.GetFirstItem("DummyRichText")
Call rtitemA.AppendRTItem( rtitemB )
Call rtitemB.Remove()
Call doc.save(False, False)

EmbedPictureIntoRichText = True

End Function

Exportação Genêrica para Excel

DECLARATION

Dim session          As NotesSession
Dim wks                As NotesUIWorkspace
Dim db       As NotesDataBase

Dim Uiview            As NotesUIView
Dim view                As NotesView
Dim column           As NotesViewColumn

Dim doc         As NotesDocument
Dim qtdePlanilha   As Long
Dim Linha As Long
Dim Coluna As Long
Dim ExcelApp         As Variant
Dim WorkBook  As Variant
Dim NomePlanilha As Variant
Dim ConteudoColuna As Variant
Dim PrimeiroTraco As Variant

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

INICIALIZE

Sub Initialize
On Error Goto TratarErro

Dim Path                   As String
Dim QtdeTotalDocs        As Long
Dim qtdedocs As Long


Set session                     = New NotesSession
Set  wks                           = New NotesUIWorkspace
Set uiView                       = wks.CurrentView
Set db            = session.CurrentDataBase
Set view                           = db.GetView( uiView.ViewName ) ' seta a visão corrente
Set doc                             = view.GetFirstDocument

QtdeTotalDocs                  = view.AllEntries.Count
NomePlanilha                = view.Aliases
Path                                  = "N:\GJD_Online\EXPORTACAO_JAN2012\"

If doc Is Nothing Then
Msgbox "Não existem documentos para exportar."
Exit Sub
End If

Set ExcelApp                    = CreateObject("Excel.Application")

With ExcelApp

.Visible     = True
Set WorkBook     = .Workbooks
WorkBook.Add

'*****************************************************************************************************************************************************************************************
If QtdeTotalDocs > 65536 Then ' se quantidade de documentos da visão corrente for maior que o total de linhas do excel
QtdePlanilha                 = 1 ' inicializa QtdePlanilha para gerar varias planilhas da mesma visão
Else
QtdePlanilha                 = 0
End If
'*****************************************************************************************************************************************************************************************

'*************************************************************PREENCHIMENTO DO CABEÇALHO EXCEL****************************************************************************
Coluna                            = 1  'inicializa a coluna para preencher o cabeçalho
Call sub__Cabecalho()
'******************************************************************************************************************************************************************************************
Linha                               = 2 'preenche as informações a partir da linha 2

qtdedocs = 1 ' quantidade de documentos exportados

While Not doc Is Nothing


%REM
'******************************************************************** criação de novas planilhas no mesmo arquivo excel***************************************************
If Linha > 65536 Then
NomePlanilha = "Plan" + Cstr(qtdePlanilha)
ExcelApp.Sheets(NomePlanilha).Select ' seleciona a proxima planilha da mesma pasta

If qtdePlanilha > 3 Then
ExcelApp.Sheets.Add ' adiciona nova planilha
End If

Coluna = 1 ' inicializa a coluna para preencher o cabeçalho
Call sub__Cabecalho()

Coluna = 1 ' inicializa a coluna para preencher as informações
Linha = 2 ' inicializa a linha

qtdePlanilha = qtdePlanilha + 1
Else
Coluna = 1
End If
'********************************************************************************************************************************************************************************
%END REM

Coluna = 1
Forall col In view.Columns
'*****************************************************INCLUSÃO DE UM ESPAÇO VAZIO NO INICO DO TEXTO PARA TRATAR O ERRO NA EXPORTAÇÃO ( automation object error)**********************
If Instr(col.Title,"COMENTARIO") > 0 Or Instr(col.Title,"DESCRICAO") > 0  Or  Instr(col.Title,"OBSERVA") Then
If Not Isarray(doc.ColumnValues(Coluna-1))  Then
PrimeiroTraco = Left(doc.ColumnValues(Coluna-1),1)
If PrimeiroTraco = "-"  Or PrimeiroTraco = "=" Then
ConteudoColuna = "  " + doc.ColumnValues(Coluna-1)
Else
ConteudoColuna = doc.ColumnValues(Coluna-1)
End If
End If
Else ' não é campo de comentario
ConteudoColuna = doc.ColumnValues(Coluna-1)
End If
'****************************************************************************************************************************************************************************************
If  Isempty(ConteudoColuna)Then
.cells(Linha,Coluna) = ""
Else
If Isarray(ConteudoColuna)  Then ' é um array

.cells(Linha,Coluna)  = Join(ConteudoColuna,",") ' transforma array em uma string

Else ' não é array
If Isnumeric(ConteudoColuna) Then
If Instr(Ucase(col.Title),"DAT") > 0 Or  Instr(Ucase(col.Title),"DT") > 0 Or Instr(Ucase(col.Title),"AJUIZAMENTO")_ ' CAMPOS DE DATA
Or  Instr(Ucase(col.Title),"ID") > 0 Then
.cells(Linha,Coluna) =    Cstr(ConteudoColuna)
Else
.cells(Linha,Coluna).FormulaR1C1 =   ConteudoColuna ' Retorna ou define a fórmula para o objeto, usando notação em estilo L1C1 no idioma do usuário
End If

Else ' não é numero
.cells(Linha,Coluna) =  Cstr(ConteudoColuna)
End If ' IS NUMERIC
End If ' IS ARRAY
End If ' IS EMPTY

Coluna = Coluna + 1
End Forall


If QtdeTotalDocs > 65536 And Linha = 65536  Then ' ultimo registro do excel

'salva a planilha
.ActiveWorkbook.SaveAs Path & NomePlanilha(0) & "_" + Cstr(QtdePlanilha)

'Criar outro arquivo excel ( pasta)
.Workbooks.Add

Coluna = 1 ' inicializa a coluna para preencher o cabeçalho
Call sub__Cabecalho()

Coluna = 1 ' inicializa a coluna para preencher as informações
Linha = 2 ' inicializa a linha

QtdePlanilha     = QtdePlanilha  + 1

Elseif (QtdeTotalDocs  =  qtdedocs) And (QtdePlanilha > 0)   Then ' ultimo doc exportado
.ActiveWorkbook.SaveAs Path & NomePlanilha(0) & "_" + Cstr(QtdePlanilha) ' salva arquivo
Else
Linha = Linha + 1
End If


Set doc = view.GetNextDocument(doc)

If Not doc Is Nothing Then
qtdedocs = qtdedocs + 1
End If

Wend

'********************************************CONVERTE AS COLUNAS DE DATA PARA O TIPO GERAL***********************************
Coluna = 1
Forall col In view.Columns
Set column = view.Columns( Coluna -1)
If column.Formula<>"""1""" And column.Formula<>"1" Then
If  Instr(Ucase(col.Title),"DAT") > 0 Or  Instr(Ucase(col.Title),"DT") > 0  Or Instr(Ucase(col.Title),"AJUIZAMENTO")_
Or  Instr(Ucase(col.Title),"VALOR") > 0  Or Instr(Ucase(col.Title),"LITRO") >0 Or  Instr(Ucase(col.Title),"ID") > 0 Then
ExcelApp.Columns(Coluna).NumberFormat =  "Geral" ' Converte a coluna para o tipoGeral
End If
End If
Coluna = Coluna + 1
End Forall
'*****************************************************************************************************************************************************

If QtdePlanilha  =  0 Then
.ActiveWorkbook.SaveAs Path & NomePlanilha(0)
End If

Set ExcelApp = Nothing
Set WorkBook = Nothing

End With

Exit Sub
TratarErro:

If Not ExcelApp Is Nothing Then
Set ExcelApp = Nothing
Set WorkBook = Nothing
'Call ExcelApp.Quit
End If

Msgbox "Erro " + Cstr(Err) +  " " + Error + " Na linha " + Cstr(Erl)
End Sub



++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

FUNCTION REPLACESUBSTRING

Function ReplaceSubstring(StrConteudo As String, StrDe As String, StrPara As String) As String
   ' Essa Função substitui caracteres na String que é passada atraves da variavel StrConteudo
   ' StrDe é(são) o(s) caracter(es) a ser(em) alteardo(s)
'StrPara  (é(são) o(s) novo(s) caracter(es)
Dim StrTemp As String
Dim StrConvertido As String
Dim i As Long
Dim length As Long
StrTemp = StrConteudo
If Len(StrDe) = 0 Then
ReplaceSubstring = StrConteudo
Exit Function
End If
If Instr(StrPara, StrDe) <> 0 Then
i = 128
length = 1
StrConvertido = ""
While StrConvertido = ""
If Instr(StrTemp, String$(length, Chr$(i))) = 0 Then StrConvertido = String$(length, Chr$(i))
i = i + 1
If i = 256 Then
length = length + 1
i = 128
End If
Wend

While Instr(StrTemp, StrDe) <> 0
StrTemp = Left(StrTemp, Instr(StrTemp, StrDe)-1) & StrConvertido _
& Mid(StrTemp, Instr(StrTemp, StrDe)+Len(StrDe))
Wend
While Instr(StrTemp, StrConvertido) <> 0
StrTemp = Left(StrTemp, Instr(StrTemp, StrConvertido)-1) & StrPara _
& Mid(StrTemp, Instr(StrTemp, StrConvertido)+Len(StrConvertido))
Wend
Else
While Instr(StrTemp, StrDe) <> 0
StrTemp = Left(StrTemp, Instr(StrTemp, StrDe)-1) & StrPara _
& Mid(StrTemp, Instr(StrTemp, StrDe)+Len(StrDe))
Wend
End If
ReplaceSubstring = StrTemp
End Function


++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB_CABECALHO

Sub sub__Cabecalho ()
'preencher o cabeçalho

Forall col In view.Columns
Set column = view.Columns( Coluna -1)

If column.Formula<>"""1""" And column.Formula<>"1" Then
'As colunas com valores de data, foram convertidas para texto para o tratamento do erro "automation object error" devido a data invalida com ano de 3 digitos
If Instr(Ucase(col.Title),"COMENTARIO") > 0 Or Instr(Ucase(col.Title),"DESCRICAO") > 0  Or  Instr(Ucase(col.Title),"OBSERVA") Or  Instr(Ucase(col.Title),"DAT") > 0_
Or   Instr(Ucase(col.Title),"DT") > 0 Or Instr(Ucase(col.Title),"AJUIZAMENTO") > 0 Or  Instr(Ucase(col.Title),"VALOR") > 0  Or Instr(Ucase(col.Title),"LITRO") >0_
Or  Instr(Ucase(col.Title),"ID") > 0 Then
ExcelApp.Columns(Coluna).NumberFormat = "@" ' Converte a coluna para o tipo Texto
End If
ExcelApp.cells(1,coluna) = column.Title
ExcelApp.Columns(Coluna).EntireColumn.AutoFit
Coluna = Coluna + 1
End If
End Forall
End Sub