Toon posts:

[VBA] Functie op een veld moet een 2de veld checken

Pagina: 1
Acties:

Verwijderd

Topicstarter
Hallo.

Ik zit met een klein vraagje ivm VBA.
Momenteel heb ik een aantal functies geschreven om uit te voeren om de velden van een access database tabel, zoals:
code:
1
2
3
4
SELECT DISTINCT account.id, 
account.company_name, 
turnover: leadingZeros(account.turnover, 9)
FROM account;


Nu heb ik een tabel met dergelijke gegevens:
code:
1
2
3
4
5
6
7
CUI      First Name        Middle Name         Last Name
1        Michael                               J Fox
2        Michael           J                   Fox
3        Michael J                             Fox
4        Michael J Fox                         
5        Michael Fox       J                   
6        John             Fitzerald           Kennedy


Ik moet hier iets maken die First Name en Middle name verbindt met een underscore. Maar soms staat de J in First Name, some in Last Name.

Is er een manier in VBA om een functie te maken zoals in de query hierboven die ook in één of meerdere andere velden kan kijken en bepaalde scenarios kan doorlopen ? In VB zelf zou ik dat kunnen via recordsets e.d., maar kan ik dat niet. Ik heb geen echte VB, enkel die debugger van Access en verder ook geen boek op het werk.

MSDN afschuimen heeft niet veel geholpen.

  • NMe
  • Registratie: Februari 2004
  • Laatst online: 19-05 21:24

NMe

Quia Ego Sic Dico.

De beste manier is natuurlijk je database consistent houden of maken, maar daar zul je wel weinig voor voelen. :)

Misschien iets in de richting van alle delen van de naam samenvoegen, en dan alle spaties behalve de laatste in een naam vervangen door underscores?

'E's fighting in there!' he stuttered, grabbing the captain's arm.
'All by himself?' said the captain.
'No, with everyone!' shouted Nobby, hopping from one foot to the other.


Verwijderd

Topicstarter
Dat van consisitent houden wil ik héél graag doen :9
Die data komt echter van flat file die we van klanten krijgen en die in hun database dienen te worden gezet. Die klanten krijgen hun files van Duns & Bradstreet, die in principe al consistente data moeten leveren, maar die echter te wensen overlaat. Vandaar dat die data tussengenomen wordt vooraleer die in MSM/AS400 worden gezet. De data moet daar aan strikte regels voldoen.

Data zoals in het voorbeeld is natuurlijk onaanvaardbaar, vandaar dus VB en Access

  • farlane
  • Registratie: Maart 2000
  • Laatst online: 22-05 16:53
Je kunt volgens mij in je query een functie aanroepen, met de velden als parameters, eigenlijk net zoals in je voorbeeld.

Somniferous whisperings of scarlet fields. Sleep calling me and in my dreams i wander. My reality is abandoned (I traverse afar). Not a care if I never everwake.


Verwijderd

Topicstarter
Ik heb nu deze functie gemaakt na wat opzoekwerk.
Mijn sql is precies niet 100% in orde omdat in alle gevallen er N/A uitkomt ipv OK.
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Public Function contactName(ByVal table As String, ByVal key As Variant, ByVal field1 As String, ByVal field2 As String, ByVal field3 As String, ByVal field4 As String) As Variant

Dim cn As Connection
Dim rs As Recordset
Dim strSQL As String
Dim resStr As String

strSQL = "SELECT " + field1 + ", " + field2 + ", " + field3 + " FROM " + table + " WHERE " + field4 + " = "" + key + """

Set cn = CurrentProject.Connection
Set rs = New Recordset

rs.Open strSQL, cn, adUseClient, adLockReadOnly

If rs.EOF = False Then
    resStr = "N/A - " + strSQL
Else
    resStr = "OK - " + strSQL
End If

contactName = resStr

End Function


Dit gaat er dus in:
code:
1
2
3
4
5
6
SELECT GB_CNTUPD.current_individual_key,
GB_CNTUPD.meta_first_given_name, 
GB_CNTUPD.meta_second_given_name, 
GB_CNTUPD.meta_surname, 
contactName("GB_CNTUPD",[GB_CNTUPD]![current_individual_key],"[GB_CNTUPD]![meta_first_given_name]","[GB_CNTUPD]![meta_second_given_name]","[GB_CNTUPD]![meta_surname]","[GB_CNTUPD]![current_individual_key]") AS FUNCTION
FROM GB_CNTUPD;


Wat eruit komt is ook niet correct :s

Is het ook mogelijk om on the fly een nieuwe kolom te introduceren die een iets aangepaste meta_first_given_name bevat bijvoorbeeld ?
Of is het mogelijk om direct de waarde van meta_first_given_name aan te passen ?

Sorry voor de layout O-)

[ Voor 29% gewijzigd door Verwijderd op 09-09-2004 14:42 ]


Verwijderd

Topicstarter
Gisteren avond gevonden:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Public Function contactName(ByVal table As String, ByVal key As Variant, ByVal field1 As String, ByVal field2 As String, ByVal field3 As String, ByVal field4 As String) As Variant

Dim cn As Connection
Dim rs As Recordset
Dim strSQL As String
Dim resStr As String

strSQL = "SELECT " + field1 + ", " + field2 + ", " + field3 + " FROM " + table + " WHERE " + field4 + " = """ + key + """"

' Set cn = CurrentProject.Connection
Set cn = New Connection
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open "C:\Documents and Settings\Administrator\My Documents\Data Briefs\GB_MSM.mdb"

Set rs = New Recordset

rs.Open strSQL, cn, adUseClient, adLockReadOnly

If rs.EOF = True And rs.BOF = True Then
    resStr = "N/A - " + strSQL
Else
    resStr = "OK"
End If

contactName = resStr


Om performance redenen heb ik het echter anders gedaan.
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Function contactNameSimple(ByVal S As Variant, ByVal T As Variant, ByVal U As Variant) As Variant
    If Len(S) <> 0 Then
        If (Not IsNull(T) And Not IsNull(U)) Then
            S = LTrim(S)
            S = RTrim(S)
            For I = 1 To Len(S)
                Let S = Replace(S, " ", "_", , , vbTextCompare)
            Next I
        Else
            If (Not IsNull(T) And IsNull(U)) Then
                S = LTrim(S)
                S = RTrim(S)
                For I = 1 To Len(S)
                    Let S = Replace(S, " ", "_", , , vbTextCompare)
                Next I
            Else
                If (IsNull(T) And Not IsNull(U)) Then
                    S = LTrim(S)
                    S = RTrim(S)
                    For I = 1 To Len(S)
                        Let S = Replace(S, " ", "_", , , vbTextCompare)
                    Next I
                End If
            End If
        End If
    Else
        'Nothing to do
    End If
    
    contactNameSimple = S
    
End Function
Pagina: 1