DLookUp fuction

Version 1 (All directories including subdirectories)
=========
'Add 1 command button and a list box.

Option Explicit

Const ARRAY_INITIAL = 1000
Const ARRAY_INCREMENT = 100

Const FILE_ATTRIBUTE_DIRECTORY = &H10
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

Dim arrFiles() As String

Private Sub Command1_Click()

    Dim x As Integer
   
    List1.Clear
    List1.Visible = False
   
    Call spanFolders("c:\windows\", "*.*")
   
    For x = 0 To UBound(arrFiles)
        List1.AddItem arrFiles(x)
    Next x
   
    List1.Visible = True
End Sub

Public Function spanFolders(startfolder As String, _
   srchstr As String)
   
    Dim sFilename As String
    Dim sfoldername As String
    Dim idx As Integer
    Dim limit As Integer
   
    ReDim arrFiles(ARRAY_INITIAL)
    On Error GoTo errHandle
   
    idx = 0
    arrFiles(0) = startfolder
    limit = 1
    ' get all the folder names and store in an array

    Do While idx < limit
        sfoldername = arrFiles(idx)
        sFilename = Dir(sfoldername & srchstr, vbDirectory)
        Do While sFilename <> ""
           
            If GetFileAttributes(sfoldername & sFilename) = _
                    FILE_ATTRIBUTE_DIRECTORY Then
                If sFilename <> "." And sFilename <> ".." Then
                   arrFiles(limit) = sfoldername & _
                       sFilename & "\"
                    limit = limit + 1
                End If
               
            End If
            sFilename = Dir
        Loop
        idx = idx + 1
    Loop
   
    ReDim Preserve arrFiles(limit - 1)
   
    Exit Function
   
errHandle:
    If Err.Number = 9 Then
        ReDim Preserve arrFiles(UBound(arrFiles) + _
            ARRAY_INCREMENT)
        Resume
    Else
        Err.Raise Err.Number, Err.Source, Err.Description
    End If
   
End Function



hongjun

ignore above comment

if the varaible part is String you need to wrap in single quotes


>>>  ","[cmbFindingCode] = '" & [Finding Code] & "'")

and leave the bracket-pair

Regards, Franz

Is there a reason you aren't just filtering the form by the value of the selected combo box?

I still get the same error #ERROR

=DLookUp("[Finding Description] ","qryFRReport","([cmbFindingCode] = '" & [Finding Code] & "')")

Is the DLooup fuction correctly placed on the controlsource of the text box?

As per Franz's I have places single quotes around the string the code is alpha/numeric.

Help!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Rafael

Check this link:

https://www.experts-exchange.com/questions/20795082/dlookup-error.html

Why not have that combobox store the description as a hidden column, and then populate the textbox with something like:

cboWhatever_AfterUpdate()
  txtFindingDescription.value = cboWhatever.Column(3)  'presuming it's an unbound control for display only

If your combo box is based on a query, have the description as part of the query (visible) and then in the properties for the combo box, have the width of that column set to 0.  That way it is there to reference but the user doesn't see it.

-Lynz

Rafael,

leave the brackets away !!

the crrect syntax is:

DLookup("[Field]", "Table/Query", "[SomeNumberField] = 1")
DLookup("[Field]", "Table/Query", "[SomeStringField] = 'somestring'")

Regards, Franz

It seems that your comboname may be in the wrong position within the criteria.


=Nz(DLookup("[Finding Description]", "qryFRReport", "[cmbFindingCode]='" & [Finding Code] & "'"), "")
---------------------^--Field in query-------^--Queryname-----^FieldInQuery------------^-ComboName---

Perhaps this:
=Nz(DLookup("[Finding Description]", "qryFRReport", "[Finding Code]='" & [cmbFindingCode] & "'"), "")
Alan :)

First Thanks for all the input I have learned a great deal an now!!!!

I'm getting close!!!!!


=DLookUp("[Finding Description]","[Findings Master]","[Finding Code] = ' " & [Forms]![fritest]![cmbFindingCode] & " ' ")

I get no error!! but the txt box stays blank

The I most be forgeting something.

Please give me couple of more chances.

Thanks

Rafael

Hi rafael,

put it in the afterupdate event for the combobox
Private Sub cmbFindingCodeAfterUpdate()
YourTextBox=DLookUp("[Finding Description]","[Findings Master]","[Finding Code] = ' " & [Forms]![fritest]![cmbFindingCode] & " ' ")
End Sub

What is the data type of the field [Finding Code]?

Private Sub cmbFindingCode_AfterUpdate()
FindingDescription = DLookup("[Finding Description]", "[Findings Master]", "[Finding Code] = ' " & [Forms]![FRI]![cmbFindingCode] & " ' ")
End Sub

The error read You can assign a value to this object!

Rafael

Hi Rafael,

that looks promising!



Just for testing:
Create a new textbox called txtTest.


Private Sub cmbFindingCode_AfterUpdate()
Me.txtTest = DLookup("[Finding Description]", "[Findings Master]", "[Finding Code] = ' " & [Forms]![FRI]![cmbFindingCode] & " ' ")
End Sub

Alan :)

Here we go again!!!!!!

Private Sub cmbFindingCode_AfterUpdate()
Me.txtTest = DLookup("[Finding Description]", "[Findings Master]", "[Finding Code] = ' " & [Forms]![FRI]![cmbFindingCode] & " ' ")
End Sub

Nothing happens!!

Let me go over

"txtTest" is the name of the text box that will hold the content of [Finding Description]

[Finding Description] if the name of the field on a table call [Findings Master]

[Finding Code] is the name of the field thats hold the codes that links to the combobox.

FRI is the name of the forms where the txtText and cmbFindingCode both reside.


The combo box get populated by a query call qryFRReport this query contains all the necessary field for the forms. it actualy a very short form with less that 10 fields.

since it works but nothing goes into the txtTest text box I assume the it is not picking up the right field or they are out of order.

What do you think??

I deleted the previous text box like you ask me and crested a new box call txtTest.

The results are still the same.

Thanks

Rafael

Hi Rafael,

Frustrating isn't it ?

I suspect it is working but finding no matching results, try using the NZ function to convert a null result into something we can see:

Me.txtTest = NZ(DLookup("[Finding Description]", "[Findings Master]", "[Finding Code] = ' " & [Forms]![FRI]![cmbFindingCode] & " ' "),"No Match")

Alan :)

Alan your are "Correct" "Right on the Money" I now get the message No Match on the textbox. At least I'm getting something.

The new question why is not finding a match. the Finding Code field is a text field 8 char nothing extra the finding code that the combo box is displaying are not only correct but I check and they are on the table with description.

What gives?

Thanks

Rafael

Hi Rafael,

This is good news !

Can you write a new query, just for testing puposes

Select Top 1 [Finding Description] From [Findings Master]

And post the result here please:

I'd like to see a sample of the data in field Finding Description.

Alan :)

Just for testing this query has all the fields but only about 20 rows but it is a good sample off all the data.

The Finding Code of the first field is 00note01 what follows is the description I want in the text box.

Report Number      StructuralArea      Letter      Finding Code      Finding Description      Recommendation      FRSection
03-01                  00note01      WE GUARANTEE CHEMICAL TREATMENTS AND FUMIGATION DONE BY THIS COMPANY FOR ONE YEAR FROM THE DATE OF COMPLETION. WE GUARANTEE WATER DAMAGE REPAIRS FOR THIRTY (30) DAYS FROM THE DATE OF COMPLETION. WE CANNOT GUARANTEE WORK DONE BY THE OWNER ORTHE OWNERS' AGE            
03-01                  00note02      NOTE: THIS COMPANY WILL RE-INSPECT REPAIRS DONE BY OTHERS WITHIN FOUR MONTHS OF THE ORIGINAL INSPECTION. A CHARGE IF ANY, CAN BE NO GREATER THEN THE ORIGINAL INSPECTION FEE FOR EACH RE-INSPECTION AND IF INSPECTION OF CONCEALED AREAS IS DESIRED, INSPECTION            
03-01                  00note04      NOTE: IF, DURING THE PERFORMANCE OF ANY REPAIRS, OR RE-INSPECTIONS  BY THIS COMPANY, ANY INFESTATIONS OR INFECTIONS ARE REVEALED THAT WERE NOT EVIDENT AT THE TIME OF OUR ORIGINAL INSPECTION, WE WOULD ISSUE A SUPPLEMENTAL REPORT WITH FINDINGS, RECOMMENDATION            
03-01                  xxmold      Note: This property was not inspected for the presence or absence of health/toxic related molds of fungi. By California law we are neither qualified , authorized, nor licensed to inspect for health related molds or fungi. If you desired information about             
03-01                  xxnote08      NOTE: State law requires that you be given the following information: CAUTION-PESTICIDES ARE TOXIC CHEMICALS. Strucural Pest Control Companies are registered and regulated by the Structural Pest Control Board, and apply pesticides which are registered and            
03-01                  xxnote09      NOTICE:  THE STRUCTURAL PEST CONTROL BOARD ENCOURAGES COMPETITIVE BUSINESS PRACTICES AMONG REGISTERED COMPANIES. REPORTS ON THIS STRUCTURE PREPARED BY VARIOUS REGISTERED COMPANIES SHOULD LIST THE SAME FINDINGS (I.E. TERMITE INFESTATIONS, TERMITE DAMAGE, F            
03-01                  xxxxend      Thank you for using USA Termite Control. For questions or further information rgarding this inspection report, contact Gerald L. Boesel at (707) 485-5759.            
03-01      1 = Subterranean Termites      1A      11em21            Owner should engage services of licensed roofing contractor to inspect the roof coating system, make necessary repairs and certify the roof against leaks.      
03-01      3 = Fungus/Dryrot      3A      blanks      Fungus damage was evident to edge of roof sheathing and/or fasica board in multiple areas around perimeter eave areas. This is caused by lack of appropriate drip edge and/or absence of proper gutter system or flashing.      Remove fascia from around perimeter, check for further damage. Issue supplemental report on conditions found with additional costs for completion if needed.  Remove and replace damaged eave members or roof sheathing with new material. Install new fascia board and a new properly flashed gutter and downspout system.      
03-01      3 = Fungus/Dryrot      3B      blanks      Wood destroying fungus infection found at  underside of rear wood deck areas.      Apply deck wash solution to underside of deck, the power wash to remove surface fungus, then chemically treat underside with zinc or copper naphthnathe to aid in the control of  wood destroying fungus infection.      
03-01      4 = Other Findings      4A      04ec02      The wooden steps at left rear are in earth contact.      Install a concrete bottom step to eliminate earth contact.      2
03-01      4 = Other Findings      4B      11em08      Water stains are evident at underside of eave area.      Owner should engage services of licensed roofing contractor to inspect the roof coating system, make necessary repairs and certify the roof against leaks.      2
03-01      4 = Other Findings      4C      04ec02      The wooden steps at rear are in earth contact.      Install a concrete bottom step to eliminate earth contact.      2
03-01      4 = Other Findings      4D      11ec01      Wood members are in earth/wood contact at rear deck posts.      Lower soil grade in this area to provide at least 3 inches minimum clearanace between soil and wood members and to break earth contact.      2
03-01      5 = Futher Inspection      4F      blanks      Water stains were evident adjacent to plumbing under the bathroom area. These appear to be old and no leaks were evident at time of this inpsection.      Periodic inspection recommended.      
03-01      4 = Other Findings      4G      01cd01      A slight amount of cellulose debris was found in the subarea soil.      Remove all cellulose debris of a size that can be raked or larger.      2
03-01      5 = Futher Inspection      5A      blanks      This structure has boxed or enclosed eaves which renders them inaccessible for inspection.      We can supply a bid on request to remove portions of sophit material and further inspect eave area as desired.      
03-01      5 = Futher Inspection      5B      blanks      Exterior wood deck has recently been re-painted. New paint can conceal adverse conditions. Only those conditions that are visible and evident at time of this inspection are included in this report.      Periodiic inspections are recommended. Should adverse conditons become evident  in the future, we would inspect those areas for an additional charge and issue a supplemental report with appropriate findings at that time.      
03-01      5 = Futher Inspection      5C      blanks      Rear ramp/dock was not inspected      If inspection  to floating ramp/dock is desired, we would inspect those area for an additional charge.      

03-01      5 = Futher Inspection      5D      blanks      There is a glass block window located within the shower line in master bath. No indications of moisture intrusion was present at time of this inspection.      Periodic inspections are advised.      

03-01      5 = Futher Inspection      5F      01ia01      The floor area is insulated which renders it inaccessible for inspection. The underside of floor was visibly inspected as practical and no adverse conditions were evident in the accessible areas.      Periodic inspections are advised. If further inspection to this area is desired, then remove insulation and further inspect underfloor framing.      F

Rafael

Hi Rafael,

This is getting a little more complex because you want to return part of a field not all of a field, however this shuld work for you.


Private Sub cmbFindingCode_AfterUpdate()
 

  Dim sFindingCode as string
  Dim i As Integer
  Dim s As String
  sFindingCode = Nz([Forms]![FRI]![cmbFindingCode] ,"")
 
  ' if nothing in combo exit sub
  If sFindingCode = "" then: Exit Sub
 
  s = Nz(DLookup("[Finding Description]", "[Findings Master]", "[Finding Code] = ' " & sFindingCode & " ' "), "No Match")
 
  If s <> "No Match" Then
    i = InStr(1, s, sFindingCode)
    If i > 0 Then
      i = i + Len(sFindingCode)
      s = Trim(Mid(s, i))
    End If
  End If
 
  Me.txtTest  = s

End Sub

Alan :)

Allan I still get no match. But what do you mean by I want to return only part of the field. If the field is 8 chars And the code is only 6 char is that part of the field.

I tested with code that have 8 char returning 8 char and I still get no match. But is the solution is to make the code the same size as the field that should not be a problem I'm just starting to create the code and they can be anything.

Thank you for all your effort ans pacience.

Rafael

Hi Rafael,

Just check something for me please.

Open your table [Findings Master] and dblClick one of the [Finding Code] fields.

Tell me if the highlight selection extends beyond the end of the word.

I think there may be some space padding in your field values

So Finding Code [01ia01     ] is what is stored but we are looking for [01ia01], therefor we get no match.

hang in there, we are nearly there.


Alan :)

Thank you for hang in there.

If I double click the table field and on the resulting query it highlight only the char in the field if the code is 6char it only highlight the 6 char.

Thanks

Rafael

Hi Rafael

Sorry mate, I was rushing that and I forgot to populate sFindingCode variable

Put these lines in:
  sFindingCode = Nz([Forms]![FRI]![cmbFindingCode] ,"")
  ' if nothing in combo exit sub
  If sFindingCode = "" then: Exit Sub


Before this line:
sql = "Select [Finding Description] From [Findings Master]"

Alan :)

Hey Rafael,

What is the rowsource for cmbFindingCode?
If [Finding Description] is in one of the columns for the combo box we can just get it from there.

me.txtTest = Me.cmbFindingCode.Column(x)   where x is the column index.
Column indexes are zero based so the first column is 0, the second column is 1 etc...


Just a thought !

Alan :)

Alan,

Your are the MAN!!!!!!

It works perfectly. I was using the combo column to populate the text box before and it work just fine, but combobox are limited to just 255 char and some of the finding are larger that that so I had to change to a memo field and the combo would cut the text after 255 char.

so I had to change to the dlookup that you just help me to make it work.

If you know a better way just let me know.

Thanks very much for all your help.

Rafael