segunda-feira, 26 de julho de 2010

DbColumn em Ls

Function DbColumn(strServer As String, strDB As String, strView As String, column As String) As Variant

On Error Goto ops

Dim session As notesSession
Dim db As notesDatabase
Dim dbTmp As notesDatabase
Dim viewTmp As NotesView
Dim Nvcol As NotesViewEntryCollection
Dim ventry As NotesViewEntry
Dim col As notesViewColumn
Dim tmpArray() As Variant
Dim tmpcount As Long


Set session = New NotesSession
Set db = session.currentDatabase

If strServer = "" Then
strServer = db.Server
End If
If strDB = "" Then
Set dbTmp = db
Else
Set dbTmp = session.GetDatabase(strServer, strDB)
End If

If dbTmp Is Nothing Then
Msgbox "Base não encontrada ou não pode ser abertar"
DbColumn = ""
Exit Function
End If

Set viewTmp = dbTmp.GetView(strView)
If viewTmp Is Nothing Then
Msgbox "View não encontrada"
DbColumn = ""
Exit Function
End If

Call viewTmp.Refresh

Set Nvcol=viewTmp.AllEntries

If Nvcol.Count <> 0 Then
Set ventry = Nvcol.GetFirstEntry()
If (ventry Is Nothing) Then
DbColumn=""
Exit Function
End If

tmpcount=0
While Not (ventry Is Nothing)
Redim Preserve tmpArray(tmpcount)
' pega os valores na coluna
tmpArray(tmpcount) = Cstr(ventry.ColumnValues(column))
tmpcount=tmpcount + 1
Set ventry = Nvcol.GetNextEntry(ventry)
Wend
'Retorna o resultado
DbColumn = Arrayunique(tmpArray)
Else
DbColumn = ""
End If



sai:
Exit Function
ops:
Msgbox "Erro na função DbColumn na linha " & Erl & " do tipo " & Err & " " & Error
DbColumn = ""
Resume sai
End Function

Nenhum comentário:

Postar um comentário