Dicas do OsmarJr
Concatenando detalhes em consultas
(Q) Como faço para extrair todos os valores de um campo em uma tabela relacionada a outra em um relacionamento 1:M em uma string?
Autor:Dev Ashish
(R) A função fConcatFilho abaixo pode ser usada em uma consulta:
SELECT Pedidos.*, fConcatFilho("Detalhes do Pedido","Número do Pedido","Quantidade","Long",[Número do Pedido]) AS ValDetPed FROM Pedidos;
Este exemplo é baseado nas tabela Pedidos e Detalhes do Pedido do banco de dados Northwind. As tabelas estão relacionadas 1 para muitos (1:M). A função fConcatFilho simplesmente concatena todos os valores no campo Quantidade da tabela detalhes do Pedido onde o campo vinculante é NúmeroDoPedido, do tipo inteiro longo para cada valor de [NúmeroDoPedido] passado pela tabela Pedidos.
CODE
'************ Início do Código **********
' Este código foi escrito originalmente por Dev Hashish
' Não pode ser alterado ou distribuído
' exceto como parte de um aplicativo.
' Use-o à vontade em qualquer aplicativo
' desde que esta nota de Copyright não seja alterada.
'
' Código cortesia de
' Dev Hashish (http://www.mvps.org/access/)
'
' Tradução e adaptação
' OsmarJr (jrosmar@yahoo.com.br)
'=========================================
Function fConcatFilho(strTabelaFilho As String, _
strNomeID As String, _
strCampoConcat As String, _
strTipoID As String, _
varValorID As Variant) _
As String
' Devolve o conteúdo de um campo da tabela Muitos de um
' relacionamento 1:M, concatenado e separados por ponto-e-vírgula
'
' Exemplo de uso:
' ?fConcatFilho("Detalhes do Pedido", "NúmeroDoPedido", "Quantidade", _
' "Long", 10255)
' Onde
'
‘ Detalhes do Pedido = Tabela Muitos
' NúmeroDoPedido = Chave primária da tabela Um
' Quantidade = Nome do campo a ser concatenado
' Long = Tipo de dados da chave primária
' 10255 = Número do pedido que contém os detalhes
'
Dim db As Database
Dim rs As Recordset
Dim varConcat As Variant
Dim strCriteria As String
Dim strSQL As String
On Error GoTo Err_fConcatFilho
varConcat = Null
Set db = CurrentDb
strSQL = "SELECT [" & strCampoConcat & "] FROM [" & strTabelaFilho & "]"
strSQL = strSQL & " WHERE "
Select Case strTipoID
Case "String":
strSQL = strSQL & "[" & strNomeID & "] = '" & varValorID & "'"
Case "Long", "Integer", "Double": 'Autonumeração é tipo Inteiro Longo
strSQL = strSQL & "[" & strNomeID & "] = " & varValorID
Case Else
GoTo Err_fConcatFilho
End Select
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
' Precisamos ter certeza que os registros Sub existem
With rs
If .RecordCount <> 0 Then
' Começa a concatenar os registros
Do While Not rs.EOF
varConcat = varConcat & rs(strCampoConcat) & ";"
.MoveNext
Loop
End If
End With
' Pronto… Já temos a string concatenada
' Agora limpamos o; no final da string
fConcatFilho = Left(varConcat, Len(varConcat) - 1)
Exit_fConcatFilho:
Set rs = Nothing
Set db = Nothing
Exit Function
Err_fConcatFilho:
Resume Exit_fConcatFilho
End Function
'************ Final do Código **********
' Este código foi escrito originalmente por Dev Hashish
' Não pode ser alterado ou distribuído
' exceto como parte de um aplicativo.
' Use-o à vontade em qualquer aplicativo
' desde que esta nota de Copyright não seja alterada.
'
' Código cortesia de
' Dev Hashish (http://www.mvps.org/access/)
'
' Tradução e adaptação
' OsmarJr (jrosmar@yahoo.com.br)
'=========================================
Function fConcatFilho(strTabelaFilho As String, _
strNomeID As String, _
strCampoConcat As String, _
strTipoID As String, _
varValorID As Variant) _
As String
' Devolve o conteúdo de um campo da tabela Muitos de um
' relacionamento 1:M, concatenado e separados por ponto-e-vírgula
'
' Exemplo de uso:
' ?fConcatFilho("Detalhes do Pedido", "NúmeroDoPedido", "Quantidade", _
' "Long", 10255)
' Onde
'
‘ Detalhes do Pedido = Tabela Muitos
' NúmeroDoPedido = Chave primária da tabela Um
' Quantidade = Nome do campo a ser concatenado
' Long = Tipo de dados da chave primária
' 10255 = Número do pedido que contém os detalhes
'
Dim db As Database
Dim rs As Recordset
Dim varConcat As Variant
Dim strCriteria As String
Dim strSQL As String
On Error GoTo Err_fConcatFilho
varConcat = Null
Set db = CurrentDb
strSQL = "SELECT [" & strCampoConcat & "] FROM [" & strTabelaFilho & "]"
strSQL = strSQL & " WHERE "
Select Case strTipoID
Case "String":
strSQL = strSQL & "[" & strNomeID & "] = '" & varValorID & "'"
Case "Long", "Integer", "Double": 'Autonumeração é tipo Inteiro Longo
strSQL = strSQL & "[" & strNomeID & "] = " & varValorID
Case Else
GoTo Err_fConcatFilho
End Select
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
' Precisamos ter certeza que os registros Sub existem
With rs
If .RecordCount <> 0 Then
' Começa a concatenar os registros
Do While Not rs.EOF
varConcat = varConcat & rs(strCampoConcat) & ";"
.MoveNext
Loop
End If
End With
' Pronto… Já temos a string concatenada
' Agora limpamos o; no final da string
fConcatFilho = Left(varConcat, Len(varConcat) - 1)
Exit_fConcatFilho:
Set rs = Nothing
Set db = Nothing
Exit Function
Err_fConcatFilho:
Resume Exit_fConcatFilho
End Function
'************ Final do Código **********