I have a problem, I wanna write from a view in word document, but it it´s writing in the same column, my code is shown below:
Public Class RelatorioWord
Sub GeraRelatWord( form1 As String, agentLog As NotesLog)
' 1. Definicao de Variáveis
Dim Sessao As New NotesSession
Dim DB As NotesDatabase
Dim visao As NotesView
Dim visForm As String
Dim ec As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim Pendentes As NotesDocumentCollection
Dim pesquisa As String
Dim condicao As String
Dim DocConfig As NotesDocument
Dim strTmpPerc As String
Dim word As Variant
Dim docW As Variant
Dim selecao As Variant
Dim cell As Variant
Dim doc, docAnexos As NotesDocument
Dim arquivo As String
Dim tmp1, tmp2, tmp3, tmp4 As String
Dim strAsterisco As String 'Gleisson
' 2. Inicialização de Variáveis
Dim DataHora As New NotesDateTime("01/01/2000")
On Error Goto ErrHandle
Set DB = Sessao.CurrentDatabase
'Localiza e desanexa os modelos usados para gerar os relatórios
LocalizaDocAnexos docAnexos, agentLog
If form1 = "frmRelatorioTempoMedioDeConsultaPorStatus" Then
arquivo = "TempoMediodeConsultasRespondidas porStatus.dot"
visForm="visTempoMediodeConsultaporStatus"
End If
If form1="frmRelatorioQuantitativoRespostaPorUsuario" Then
arquivo="QuantitativodeRespostasporUsuarioeAssunto.dot"
visForm="visQuantitativoRespostaPorUsuario"
End If
'Desanexa os modelos usados na criação do relatório
desanexa docAnexos, arquivo, agentLog
'Abre word para criar o relatório
Call agentLog.LogAction("Criação do Objeto")
criaAppOLE word, docW, arquivo, agentLog
Set visao = DB.GetView(visForm)
Call visao.Refresh
Dim i As Long
Dim j As Long
Dim qtdColunas As Integer
Dim coluna As NotesViewColumn
For i=1 To visao.ColumnCount - 1
Set coluna = visao.Columns(i)
If Not coluna.IsHidden Then
qtdColunas = qtdColunas + 1 ' Número de colunas visíveis
End If
Next
Set ec = visao.AllEntries
If ec.Count > 0 Then
i = 2
Set entry = ec.GetFirstEntry
While Not entry Is Nothing
For j = 0 To qtdColunas
insereTextoELinha word, docW, 1, i, j+1, entry.ColumnValues(j), agentLog
Next
Set entry = ec.GetNextEntry(entry)
i = i + 1
Wend
End If
fechaAppOLE word, docW, arquivo, agentLog
Exit Sub
ErrHandle:
Call agentLog.LogAction("bibRelatorioWord - GeraRelatWord - Erro: "& Error & ". Linha: " & Erl)
Exit Sub
End Sub
Sub criaAppOLE ( app As Variant, docOLE As Variant, modelo As String,agentLog As NotesLog)
'Cria aplicação word e abre um novo documento usando o modelo indicado
'O modelo já deverá estar no disco C:
Dim path As String
Dim Sessao As New NotesSession
On Error Goto ErrHandle
Set app = CreateObject("Word.Application")
'app.visible = True
path = sessao.GetEnvironmentString("Directory", True)
If Instr(path, "/") <> 0 And Right(path, 1) <> "/" Then path = path & "/"
If Instr(path, "\") <> 0 And Right(path, 1) <> "\" Then path = path & "\"
path = path & "domino\html\sisco\"
' path = path & nome.Common
path = Replace(path, " ", "-")
Call app.Documents.add(path+modelo)
Call app.Documents(1).Activate
Set docOLE = app.Documents(1)
Exit Sub
ErrHandle:
Call agentLog.LogAction("bibRelatorioWord - Cria - Erro: "& Error & ". Linha: " & Erl)
Exit Sub
End Sub
Sub fechaAppOLE ( app As Variant, docOLE As Variant, arquivo As String, agentLog As NotesLog)
'fecha o documento, o word e apaga o modelo usado quando houver
Dim path As String
Dim Sessao As New NotesSession
On Error Goto ErrHandle
path = sessao.GetEnvironmentString("Directory", True)
If Instr(path, "/") <> 0 And Right(path, 1) <> "/" Then path = path & "/"
If Instr(path, "\") <> 0 And Right(path, 1) <> "\" Then path = path & "\"
path = path & "domino\html\sisco\"
app.ActiveDocument.SaveAs path & "teste.doc", 0
Call docOLE.Close(wdDoNotSaveChanges)
Call app.Quit(wdDoNotSaveChanges)
If arquivo <> "" Then
Kill path+arquivo
End If
Exit Sub
ErrHandle:
Call agentLog.LogAction("bibRelatorioWord - Fecha - Erro: "& Error & ". Linha: " & Erl)
Exit Sub
End Sub
Sub insereTextoELinha (app As Variant, docOLE As Variant, tabela As Long, linha As Long, coluna As Long, texto As Variant, agentLog As NotesLog)
'Escreve texto sem apagar o já escrito e acrescenta uma linha ao final
Dim cell As Variant
Dim selecao As Variant
On Error Goto ErrHandle
Set cell = docOLE.Tables(tabela).Cell(linha,coluna)
Call cell.Select
Set selecao = app.selection
selecao.InsertRowsBelow(1)
Call selecao.InsertBefore(texto)
Call selecao.InsertParagraphAfter
Exit Sub
ErrHandle:
Call agentLog.LogAction("bibRelatorioWord - Inserção texto e linha - Erro: "& Error & ". Linha: " & Erl)
Exit Sub
End Sub
Sub LocalizaDocAnexos ( doc As Notesdocument, agentLog As NotesLog)
Dim sessao As New NotesSession
Dim db As NotesDatabase
Dim docs As NotesDocumentCollection
Dim data As New NotesDateTime("01/01/1980")
Dim criterio As String
criterio = { form = "frmAnexos" }
Set db = sessao.CurrentDatabase
Set docs = db.Search(criterio, data, 1)
If docs.Count > 0 Then
Set doc = docs.GetFirstDocument
End If
Exit Sub
ErrHandle:
Call agentLog.LogAction("bibRelatorioWord - Localiza- Erro: "& Error & ". Linha: " & Erl)
Exit Sub
End Sub
Sub desanexa ( doc As NotesDocument, arquivo As String, agentLog As NotesLog)
Dim path As String
Dim Sessao As New NotesSession
On Error Goto ErrHandle
path = sessao.GetEnvironmentString("Directory", True)
If Instr(path, "/") <> 0 And Right(path, 1) <> "/" Then path = path & "/"
If Instr(path, "\") <> 0 And Right(path, 1) <> "\" Then path = path & "\"
path = path & "domino\html\sisco\"
' path = path & nome.Common
'path = Replace(path, " ", "-")
Call agentLog.LogAction(path+arquivo)
Dim anexo As NotesEmbeddedObject
Set anexo = doc.GetAttachment(arquivo)
Call anexo.ExtractFile(path+arquivo)
Exit Sub
ErrHandle:
Call agentLog.LogAction("bibRelatorioWord - Desanexa - Erro: "& Error & ". Linha: " & Erl)
Exit Sub
End Sub
End Class
I´m novice notes developer and Idon´t know how to develop properly in notes