Microsoft Access Forums - Programming

Value of Existing Control

CementCarver — Wed, 19 Jun 2013 14:36:10 GMT

How does not obtain the value of an existing control? I've set my control be: dim ctl as control. But when I try to debug.print it's value with:

debug.print ctl.value..... after you keyin the period, the pulldown object properties does not contain the word "Value"

I'm using Access 2010.

CementCarver

Treeview control wizard

masoud_sedighy — Wed, 19 Jun 2013 12:17:53 GMT

Before I have a question about "how to fill level 3 of treeview by query" but I did not get answer, after searching a lot in Google I read that there is a control wizard that works with Access97.

I like to know how I can use this wizard with Access 2007. That is possible?

What I have found for 2 levels is like below code for Function tvwBooks_Fill()

Design of tables and query is like below and I like to change below code for the treeview that

First level is: Author

Second level is: book

Third level is: transmittal no

------------------------------------------------------------------------------------

tblTransmittal (TransId (pk),TransmittalNo)

tblbook (Bookid (pk),title)

tblAuthor(AuthorID(pk), AuthorPrefix, AuthorFirstName, AuthorMiddleName, AuthorLastName, AuthorSuffix)

tblBookAuthors (Bookid(pk), AuthorID(pk))

tblTransmittal_Book_Author (Transid(pk), Bookid(pk), AuthorID(pk))

qryEBookAuthors:

SELECT DISTINCT tblAuthors.AuthorID, Trim(IIf([AuthorFirstName],[AuthorLastName] & IIf([AuthorPrefix],[AuthorPrefix] & " ","") & IIf([AuthorFirstName],", " & [AuthorFirstName],"") & IIf([AuthorMiddleName]," " & [AuthorMiddleName]),[AuthorLastName])) & IIf([AuthorSuffix]," " & [AuthorSuffix],"") AS LastNameFirst

FROM tblAuthors

ORDER BY Trim(IIf([AuthorFirstName],[AuthorLastName] & IIf([AuthorPrefix],[AuthorPrefix] & " ","") & IIf([AuthorFirstName],", " & [AuthorFirstName],"") & IIf([AuthorMiddleName]," " & [AuthorMiddleName]),[AuthorLastName])) & IIf([AuthorSuffix]," " & [AuthorSuffix],"");

qryEBooksByAuthor :

SELECT tblBookAuthors.AuthorID, tblBookAuthors.BookID, qryBookAuthors.LastNameFirst, tblBooks.Title, tblBooks.Type, Switch([ReadStatus]=3," " & Chr$(215),[ReadStatus]=2," " & Chr$(247)) AS BeenRead

FROM tblBooks INNER JOIN (tblBookAuthors INNER JOIN qryBookAuthors ON tblBookAuthors.AuthorID = qryBookAuthors.AuthorID) ON tblBooks.BookID = tblBookAuthors.BookID

ORDER BY qryBookAuthors.LastNameFirst, tblBooks.Title;

Code:

Function tvwBooks_Fill()

'Created by Helen Feddema 2-10-2002

'Last modified 4-23-2002

 

'============================================================

'Modified from a procedure generated by the Access 97

'Treeview Control Wizard

 

'PURPOSE: Fill the ActiveX Treeview Control 'tvwBooks' with

'author and book information

'ACCEPTS: Nothing

'RETURNS: Nothing

'CALLED FROM: Form Load event

'============================================================

 

On Error GoTo ErrorHandler

 

   Dim strMessage As String

   Dim dbs As DAO.Database

   Dim rst As DAO.Recordset

   Dim intVBMsg As Integer

   Dim strQuery1 As String

   Dim strQuery2 As String

   Dim nod As Object

   Dim strNode1Text As String

   Dim strNode2Text As String

   Dim strVisibleText As String

  

   Set dbs = CurrentDb()

   strQuery1 = "qryEBookAuthors"

   strQuery2 = "qryEBooksByAuthor"

  

   With Me![tvwBooks]

      'Fill Level 1

      Set rst = dbs.OpenRecordset(strQuery1, dbOpenForwardOnly)

 

      'Add a node object for each record in the "qryEBookAuthors" table/query.

      'The Key argument concatenates the level number and the LastNameFirst

      'field of the Level 1 query, to create a unique key value for the node.

      'The Text argument is the text displayed as a Level 1 node in the

      'TreeView control

 

      Do Until rst.EOF

         strNode1Text = StrConv("Level1" & rst![LastNameFirst], _

            vbLowerCase)

         Set nod = .Nodes.Add(Key:=strNode1Text, _

            Text:=rst![LastNameFirst])

         'Expand the entire node

         nod.Expanded = True

         rst.MoveNext

      Loop

      rst.Close

     

      'Fill Level 2

      Set rst = dbs.OpenRecordset(strQuery2, dbOpenForwardOnly)

 

      'Add a node object for each record in the "qryEBooksByAuthor"

      'table/query.

      'The value of the Relative argument matches the Key argument value

      'for the Level 1 node this Level 2 node belongs to.

      'The Relationship argument takes a named constant, tvwChild,

      'indicating that the Level 2 node becomes a child node of the

      'Level 1 node named in the Relative argument.

      'The Key argument concatenates the level number and the Title

      'field of the Level 2 query, to create a unique key value for the node.

      'The Text argument is the text displayed as a Level 2 node in the

      'TreeView control

 

      Do Until rst.EOF

         strNode1Text = StrConv("Level1" & rst![LastNameFirst], vbLowerCase)

         strNode2Text = StrConv("Level2" & rst![Title], vbLowerCase)

         strVisibleText = rst![Title]

         .Nodes.Add relative:=strNode1Text, _

            relationship:=tvwChild, _

            Key:=strNode2Text, _

            Text:=strVisibleText

         rst.MoveNext

      Loop

      rst.Close

     

   End With

   dbs.Close

 

ErrorHandlerExit:

   Exit Function

 

ErrorHandler:

   Select Case Err.Number

      Case 35601

         'Element not found

         strMessage = "Possible Causes: You selected a table/query" _

            & " for a child level which does not correspond to a value" _

            & " from its parent level."

         intVBMsg = MsgBox(Error$ & strMessage, vbOKOnly + _

            vbExclamation, "Run-time Error: " & Err.Number)

      Case 35602

         'Key is not unique in collection

         strMessage = "Possible Causes: You selected a non-unique" _

            & " field to link levels."

         intVBMsg = MsgBox(Error$ & strMessage, vbOKOnly + _

            vbExclamation, "Run-time Error: " & Err.Number)

      Case Else

         intVBMsg = MsgBox(Error$ & "@@", vbOKOnly + _

            vbExclamation, "Run-time Error: " & Err.Number)

   End Select

   Resume ErrorHandlerExit

 

End Function

Date code needed

spider — Wed, 19 Jun 2013 11:48:49 GMT

Dear all,

I am working on an HR database. I need to make month days equal to 26 days if the employee works from the beginning of the month until the end of the month.
Our weekend is only during sundays. My problem is that sometimes we have 5 sundays so the working days are equal to 25 days while it should be 26.
I have two textboxes: PaymentStartingDate & PaymentFinishingDate
I need to check if the PaymentStartingDate is the first day of the month and if the PaymentFinishingDate is the last day of the month.
If so, then the Duration will be 26 days automatically.

Thank you in advance.

Regards,

Accessing a table with a missing object

kewelch — Tue, 18 Jun 2013 20:15:32 GMT

Hello, this is my first post and I am ready to learn Acess 2010!!!. The error I am running into says that I am missing an object within the conditional statement of this if structure. Any help would be much appreciated.

Code:

    If tblAdjustment.AdjustmentTypeID = "6" Or "7" Then        total = total + tblAdjustment.AdjustmentQuantity

    Else

        total = total - tblAdjustment.AdjustmentQuantity

    End If

-Kevin The Intern

[Solved] VBA to change the greatest value textbox ForeColor (and label) to red.

rhewitt — Tue, 18 Jun 2013 18:15:50 GMT

I'm creating a summary that uses Dcount() to count the number of records that meet certain criteria (# of projects in a state, for example). Once these values are calculated I'd like to change the ForeColor of the highest value to Red so that it sticks out. I can loop through the control elements on the form, but I'm trying to figure out how to change the fore color.

I have three textboxes:
tboxRegion2
tboxRegion3
tboxRegion4

This code loops through all of the textboxes on the form and finds the one with the highest value.

Code:

    Dim c As Control    Dim txt As TextBox

    Dim high As Integer

    Dim value As Integer

    Dim tbox As String

    

    high = 0

    

    For Each c In Me.Controls

        If TypeOf c Is TextBox Then

            Debug.Print c

            value = c

            If value > high Then

                high = value

                tbox = c.Name

            End If

        End If

    Next c

This code changes the ForeColor property to red:

Code:

Me.tboxRegion4.ForeColor = RGB(255, 0, 0)

What I need to do is combine the two code blocks by building the Me. statement using the variable tbox. For example:

Code:

"Me." & tbox & ".ForeColor = RGB(255,0,0)"

I need Access to evaluate this statement rather than treat it as a string.

Recommendations?

Run-Time error 3141

CementCarver — Tue, 18 Jun 2013 16:02:57 GMT

I'm getting a run-time error 3141 regarding some select statement, but the program stops at a line that doesn't deal with a sql statement at all...?

It stops at a line where I'm passing the open arguments to a form:

DoCmd.OpenForm "frm_CREATE_PRODUCER", , , , , , MEMBER_ID

Not sure what the error message is trying to tell me.......

Any help would be appreciated......CementCarver

Object Not Supported

CementCarver — Tue, 18 Jun 2013 14:21:32 GMT

I'm using Martin Green's audit table code to track changes to my database. From the main business member form, the user can select to create a new member and then I call up the edit form to allow the user to enter in data. But I prefill the edit form with the new company name, so I think the code, which is looking for the action to be either "NEW" or "EDIT", deems this to be a new record. Which is correct.

But I've altered Martin's code for the section under CASE ELSE because for some reason when it gets to this point, the action is still be recorded as EDIT and I've tried to replicate the code to be what's above.

So I don't understand why the line "If Nz(ctl.Value) <> Nz(ctl.OldValue) Then" works in the upper section, but won't allow me to use it in the CASE ELSE section.
Plus, if I comment out this line, the line further below ![OldValue] = ctl.OldValue causes an error.

Plus, after implementing this code, there is never an entry for "NEW" rather they're all "EDIT".

Confused....CementCarver

Sub AuditChanges(MEMBER_ID As String, UserAction As String)
'On Error GoTo AuditChanges_Err
Dim cnn As ADODB.Connection
Dim rstAudit As Recordset
Dim ctl As Control
Dim datTimeCheck As Date
Dim strUserID As String
Dim MaxMember_id As Integer
Dim db As Database

Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
rst.Open "Select * from Audit_Trail", cnn, adOpenDynamic, adLockOptimistic
datTimeCheck = Now()
strUserID = CurrentUser()

MaxMember_id = DMax("[MEMBER_ID]", "BUSINESS")

Select Case UserAction
Case Edit
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = Audit Then
If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Or ctl.ControlType = acCheckBox Then
If Nz(ctl.Value) <> Nz(ctl.OldValue) Then..............BUT THIS IS THE SAME LINE BELOW AND THIS ONE WORKS...!!!
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![Record_ID] = MaxMember_id
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue
![NewValue] = ctl.Value
.Update
'Debug.Print "Current values " & UserAction
End With
End If
End If
End If
Next ctl
Case Else
For Each ctl In Screen.ActiveForm.Controls
If ctl.Tag = Audit Then
If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Or ctl.ControlType = acCheckBox Then
If (ctl.Value) <> (ctl.OldValue) Then .............THIS IS THE LINE WHERE IT STOP AND GIVES ME AN ERROR AND IF I COMMENT THIS LINE, THEN THE LINE BELOW WHICH TRIES TO LOAD THE !OLDVALUE CAUSES AN ERROR......
With rst
.AddNew
![DateTime] = datTimeCheck
![UserName] = strUserID
![FormName] = Screen.ActiveForm.Name
![Action] = UserAction
![Record_ID] = MaxMember_id
![FieldName] = ctl.ControlSource
![OldValue] = ctl.OldValue........CAUSES AN ERROR IF THE IF STATEMENT ABOVE IS COMMENTED OUT...
![NewValue] = ctl.Value
.Update
End With
End If
End If
End If
Next ctl
End Select
AuditChanges_exit:
On Error Resume Next
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
AuditChanges_Err:
MsgBox Err.Description, vbCritical, "Error!"
Resume AuditChanges_exit
End Sub

VBA and DOM to populate innerHTML on an input tag

callmeandy — Tue, 18 Jun 2013 12:13:03 GMT

Hi guys dont if anybody in this forum can help as I am not having a lot of luck elsewhere, I am using VBA from Access to automate IE .

and I have a piece of code that is not playing ball. It's not assigning a value to the innerHTML as expected.

Code:

Function PasteToWebPage(txt As String, ie As SHDocVw.InternetExplorer, Optional IfNotExactlyOne As htmlNotExactlyOne = htmlPasteToNone, Optional ElementID As String, Optional ClassName As String, Optional Name As String, Optional TagName As String, Optional href As String, Optional InnerHTML As String) As Long

Dim hDoc As MSHTML.HTMLDocument

Dim hCol As MSHTML.IHTMLElementCollection

Dim hSelect As MSHTML.HTMLSelectElement

'Dim Target As IHTMLInputElement

On Error GoTo errorHandler





Set hDoc = ie.Document





With hDoc

    

    If ElementID <> "" Then

        'ignores any value set for htmlNotExactlyOne

        .getElementByID(ElementID).InnerHTML = txt

        'If Target Is Nothing Then Err.Raise vbObjectError + 513

        'Target.setAttribute "value", txt





        PasteToWebPage = 1

        Exit Function

    End If

...

I can assign to value i.e. .getElementByID(ElementID).value = txt works fine but doesn't change the visual content on the form - confused which I should use and why its not working.

Err.Number=600 Err.Description=Application-defined or object-defined error

Any comments welcome, thanks!

Code for selecting records !! Please can someone help

the_reg — Tue, 18 Jun 2013 10:03:02 GMT

hi Guys - i am doing something simple and getting it wrong and frustratingly dont know where !! can someone help. The code below falls over on line

Me.frmsubClients.Form.RecordSource = strSQL ..... saying i have a syntax error :mad:. I am pulling records from a sub form called 'frmsubClients' thanks in advance

Private Sub btnSearch_Click()
' Update the record source
Dim strBuiltFilter As String
Dim strSQL As String
strBuiltFilter = BuildFilter
Debug.Print BuildFilter
If strBuiltFilter = "" Then
strSQL = "Select * FROM qryClientData" & strBuiltFilter
Else
strSQL = "SELECT * FROM qryClientData WHERE" & strBuiltFilter
End If
Debug.Print strSQL
Me.frmsubClients.Form.RecordSource = strSQL
' Requery the subform
Me.frmsubClients.Requery
End Sub

How to fill level 3 of treeview

masoud_sedighy — Tue, 18 Jun 2013 07:27:01 GMT

Hello

I have used below code for filling tree view with 2 levels. This tree view shows books for each Author, now I like to add level 3 (transmittal no) for each book for example author1 has 2 books (book1, book2) and then for book1 we have 4 transmittal no (tt -003, tt-1000,tt-4000,tt-5000) and for book2 we have 1 transmittal no (tt-0009)
My tables for 2 levels are:

tblAuthors (AuthorID (pk), AuthorFirstName, AuthorLastName)

tblBooks (BookID (pk),title)

tblBookAuthor (AuthorID, BookID)

Please help, now for 3 levels, what table I have to add and what changes I have to do in below code

Code:

Function tvwBooks_Fill()

'Created by Helen Feddema 2-10-2002

'Last modified 4-23-2002

 

'============================================================

'Modified from a procedure generated by the Access 97

'Treeview Control Wizard

 

'PURPOSE: Fill the ActiveX Treeview Control 'tvwBooks' with

'author and book information

'ACCEPTS: Nothing

'RETURNS: Nothing

'CALLED FROM: Form Load event

'============================================================

 

On Error GoTo ErrorHandler

 

   Dim strMessage As String

   Dim dbs As DAO.Database

   Dim rst As DAO.Recordset

   Dim intVBMsg As Integer

   Dim strQuery1 As String

   Dim strQuery2 As String

   Dim nod As Object

   Dim strNode1Text As String

   Dim strNode2Text As String

   Dim strVisibleText As String

  

   Set dbs = CurrentDb()

   strQuery1 = "qryEBookAuthors"

   strQuery2 = "qryEBooksByAuthor"

  

   With Me![tvwBooks]

      'Fill Level 1

      Set rst = dbs.OpenRecordset(strQuery1, dbOpenForwardOnly)

 

      'Add a node object for each record in the "qryEBookAuthors" table/query.

      'The Key argument concatenates the level number and the LastNameFirst

      'field of the Level 1 query, to create a unique key value for the node.

      'The Text argument is the text displayed as a Level 1 node in the

      'TreeView control

 

      Do Until rst.EOF

         strNode1Text = StrConv("Level1" & rst![LastNameFirst], _

            vbLowerCase)

         Set nod = .Nodes.Add(Key:=strNode1Text, _

            Text:=rst![LastNameFirst])

         'Expand the entire node

         nod.Expanded = True

         rst.MoveNext

      Loop

      rst.Close

     

      'Fill Level 2

      Set rst = dbs.OpenRecordset(strQuery2, dbOpenForwardOnly)

 

      'Add a node object for each record in the "qryEBooksByAuthor"

      'table/query.

      'The value of the Relative argument matches the Key argument value

      'for the Level 1 node this Level 2 node belongs to.

      'The Relationship argument takes a named constant, tvwChild,

      'indicating that the Level 2 node becomes a child node of the

      'Level 1 node named in the Relative argument.

      'The Key argument concatenates the level number and the Title

      'field of the Level 2 query, to create a unique key value for the node.

      'The Text argument is the text displayed as a Level 2 node in the

      'TreeView control

 

      Do Until rst.EOF

         strNode1Text = StrConv("Level1" & rst![LastNameFirst], vbLowerCase)

         strNode2Text = StrConv("Level2" & rst![Title], vbLowerCase)

         strVisibleText = rst![Title]

         .Nodes.Add relative:=strNode1Text, _

            relationship:=tvwChild, _

            Key:=strNode2Text, _

            Text:=strVisibleText

         rst.MoveNext

      Loop

      rst.Close

     

   End With

   dbs.Close

 

ErrorHandlerExit:

   Exit Function

 

ErrorHandler:

   Select Case Err.Number

      Case 35601

         'Element not found

         strMessage = "Possible Causes: You selected a table/query" _

            & " for a child level which does not correspond to a value" _

            & " from its parent level."

         intVBMsg = MsgBox(Error$ & strMessage, vbOKOnly + _

            vbExclamation, "Run-time Error: " & Err.Number)

      Case 35602

         'Key is not unique in collection

         strMessage = "Possible Causes: You selected a non-unique" _

            & " field to link levels."

         intVBMsg = MsgBox(Error$ & strMessage, vbOKOnly + _

            vbExclamation, "Run-time Error: " & Err.Number)

      Case Else

         intVBMsg = MsgBox(Error$ & "@@", vbOKOnly + _

            vbExclamation, "Run-time Error: " & Err.Number)

   End Select

   Resume ErrorHandlerExit

 

End Function

Clearing a range of cell in Excel from Access VBA

dccjr — Tue, 18 Jun 2013 02:24:20 GMT

OK, I have numerous ways to do this from within Excel VBA, but nothing that works from Access VBA. I can clear the entire sheet, but that is not what I want to do. I only want to clear A2:B35. This is what I have that clears the entire sheet. I know there is a way to do this, but can't find an example.

Code:

Function ClearTrendData()

Dim oXL As Object

Dim oBook As Object

Dim oSheet As Object



Set oXL = CreateObject("Excel.Application")

On Error Resume Next



oXL.UserControl = True

On Error GoTo 0

On Error GoTo ErrHandle



Set oBook = oXL.Workbooks.Open("E:\RCADatabase(FE) Current\RCACharting.xlsm")

Set oSheet = oBook.Sheets("TrendData")



oSheet.Cells.Clear

oBook.Save



ErrExit:

       oBook.Close

       oXL.Application.Quit

       Set oXL = Nothing

       Set oBook = Nothing

       Set oSheet = Nothing

       Exit Function

ErrHandle:

      oXL.Visible = False

      MsgBox Err.Description

      GoTo ErrExit

End Function

I am sure that it is a change to the blue lines. Any suggestions?

Use vba to detect if excel is open.

redbull — Mon, 17 Jun 2013 19:48:35 GMT

Hello, I am wondering if there is a way to determine of a user has an open version of excel running. I have people who are opening a .xls file from the internet. These files are being OPENED NOT SAVED to their local machines. So I wonder if I can just figure out if excel is running, then interact with it from there...

[Solved] Operation is not supported for this type of object error

CementCarver — Mon, 17 Jun 2013 19:09:28 GMT

How does one trap the location where this error is happening...." Operation is not supported for this type of object error? All I get is the message and not the line or subroutine where the error is occurring.

What causes this error to happen?

CementCarver

XXXXX cannot find the object 'False.' error message

LindaRuble — Mon, 17 Jun 2013 01:08:05 GMT

Hello,

I get the following error: " XXXX cannot find the object "False." If 'False' is a new macro group, make sure you have saved it and that you hve typed its name correctly.

I get this error when I click on a dropdown to change the selection on a Tabular Form.

I would send you my program but it's too large but I will send an attachment of the code behind the form. If you can help me then that would be great.

Thanks

Linda
TabularBetsy.JPG

Attached Images

TabularBetsy.JPG (30.7 KB)

Attached Files

code-behind-form.txt (12.5 KB)

[Solved] Double frondend to backend links following tabledef

GraeagleBill — Sat, 15 Jun 2013 22:15:51 GMT

I've attached a text file containing a sub code that creates a new table and adds the new fields. The code runs fine, but somehow I managed to create 2 links from the frontend to the backend. I.e., tbSermons and tbSermons1 I don't see where the second link came from, unless the tabledef functionality does the first one automatically?

I'd post the code inline here, but I don't know how to use the code tags?

Thanks,
Bill

Attached Files

InitVer9.txt (2.8 KB)