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