DCount using a Dim reference in Access VBA - vba

Really struggling to get my reference to register in the search? I'm trying to create a check to see if the record is already in my table?
Private Sub Command10_Click()
Me.UniqCONCAT = (Me.CQRWeekNumber) & (Me.UserNametxt) & (Me.CQRSite)
Dim KONKAT As String
KONKAT = Me.UniqCONCAT
Dim CountNumber As Integer
CountNumber = DCount("UniqCONCAT", "tblDataTable", "UniqCONCAT = 'KONKAT'")
If CountNumber > 0 Then
MsgBox "This record is already in the system"
Exit Sub
Else
MsgBox "Go Ahead"
End Sub
It works if I use a static text reference. I need to search for my concatenated data (KONKAT)
Firstly I populate a field on the form with the concatenation (and that works)
Your advice and patience is appreciated in advance.

Related

MS Access - Text field retuns the querys string instead of the query result value

I have tried a few variations, and all seem to give me the same result - so I am overlooking something pretty simple I think.
I have a text box for an account number, a search button, and a text box for the result of the search query. However, when I hit search - the query itself gets added to the second text box instead of the expected result of 1 or 0.
This is my latest attempt, found on this site:
Private Sub SearchAcctNumber_Click()
Dim strsearch As String
Dim Task As String
If IsNull(Me.Text0) Or Me.Text0 = "" Then
MsgBox "Please type in your account number.", vbOKOnly, "Acct Num Needed"
Me.Text0.SetFocus
Else
strsearch = Me.Text0.Value
Task = "SELECT I_Ind FROM dbo_BC WHERE (([ACCOUNT_NUMBER] Like ""*" & Text0 & "*""))"
Me.Text2 = Task
End If
End Sub
Is anyone able to help me see the error I am making? It is driving me nuts that something so simple isn't working how I thought it should.
Edit: Wanted to add that I've also tried DLookup and get the same result in other iterations of attempts at this.
You may want to reconsider the Like approach in this case. Anyways, the issue is that you assign a string (the SQL command) to the textbox and this is what you see.
Try this instead:
Private Sub SearchAcctNumber_Click()
If IsNull(Text0.Value) Then
MsgBox "Please type in your account number.", vbOKOnly, "Acct Num Needed"
Text0.SetFocus
Exit Sub
End If
Dim strSearch As String
Dim strCriteria As String
strSearch = Text0.Value
strCriteria = "ACCOUNT_NUMBER Like '*" & strSearch & "*'"
Text2.Value = Nz(DLookup("I_Ind", "dbo_BC", strCriteria), "Not found...")
End Sub
You could also "search" while you type on Text0. Set the minimum number of characters before attempting to locate it.
Private Sub Text0_Change()
If Len(Text0.Text) > 3 Then
Text2.Value = Nz(DLookup("I_Ind", "dbo_BC", "ACCOUNT_NUMBER Like '*" & Text0.Text & "*'"), vbNullString)
End If
End Sub
One possible way is, that you change Text2 type to combo box. Then you set Text2.recordsource = Task and you refresh the displayed value with Me.Text2.requery.
Another way is to open a recordset, read the value, and set Text2 value.
Dim r as dao.recordset, db as dao.database
set db = currentdb()
set r=db.openrecordset(Task)
Me.Text2 = r(0).value
Set r = Nothing

Is it possible to use a Pivot Table in a userform?

Is it possible to insert a pivot table into a userform in VBA? I saw this other question about it, but I'm able to find the Microsoft Office PivotTable control in the right-click menu. I did find the Tree View, but that isn't quite the same thing I don't think.
UPDATE
I'm creating an Inventory workbook for use in my office. I'll allow others to use it to see what we have and to request items that we have in inventory. I'm going to use the Userform for this. I have a dashboard for myself in the workbook that has several pivot tables already. There are 2 that I'd like to use in the Userform.
The regular users won't have access to edit the workbook, or even to change which sheet is showing, they only need access to view the 2 pivots that I want to add to this Userform.
So, the end result is going to be that the end user will have a pivot table that will allow them to see what we have in inventory and request it or send an email that will create a PO to order it.
I've been using Excel for a very long time and I've never heard of anyone need this combination (UserForm+PT), but anyway, I did a quick Google search and came up with this.
Option Explicit
Dim cnnConnection As Object
Private Sub Form_Load()
Dim strProvider As String
Dim view As PivotView
Dim fsets As PivotFieldSets
Dim c As Object
Dim newtotal As PivotTotal
strProvider = "Microsoft.Jet.OLEDB.4.0"
' Create an ADO object
Set cnnConnection = CreateObject("ADODB.Connection")
' Set the provider and open the connection to the database
cnnConnection.Provider = strProvider
cnnConnection.Open "C:\pivottest.mdb"
' Set the pivot table's connection string to the cnnConnection's connection string
PivotTable1.ConnectionString = cnnConnection.ConnectionString
' SQL statement to get everything from table1
PivotTable1.CommandText = "Select * from table1"
' Get variables from the pivot table
Set view = PivotTable1.ActiveView
Set fsets = PivotTable1.ActiveView.FieldSets
Set c = PivotTable1.Constants
' Add Category to the Row axis and Item to the Column axis
view.RowAxis.InsertFieldSet fsets("Category")
view.ColumnAxis.InsertFieldSet fsets("Item")
' Add a new total - Sum of Price
Set newtotal = view.AddTotal("Sum of Price", view.FieldSets("Price").Fields(0), c.plFunctionSum)
view.DataAxis.InsertTotal newtotal
view.DataAxis.InsertFieldSet view.FieldSets("Price")
' Set some visual properties
PivotTable1.DisplayExpandIndicator = False
PivotTable1.DisplayFieldList = False
PivotTable1.AllowDetails = False
End Sub
Private Sub Form_Terminate()
' Remove reference to the ADO object
Set cnnConnection = Nothing
End Sub
Private Sub PivotTable1_DblClick()
Dim sel As Object
Dim pivotagg As PivotAggregate
Dim sTotal As String
Dim sColName As String
Dim sRowName As String
Dim sMsg As String
' Get the selection object you double-clicked on
Set sel = PivotTable1.Selection
' If it is a aggregate, you can find information about it
If TypeName(sel) = "PivotAggregates" Then
' Select the first item
Set pivotagg = sel.Item(0)
' Display the value
MsgBox "The cell you double-clicked has a value of '" & pivotagg.Value & "'.", vbInformation, "Value of Cell"
' Get variables from the cell
sTotal = pivotagg.Total.Caption
sColName = pivotagg.Cell.ColumnMember.Caption
sRowName = pivotagg.Cell.RowMember.Caption
' Display the row and column name
sMsg = "The value is " & sTotal & " by " & sRowName & " by " & sColName
MsgBox sMsg, vbInformation, "Value Info"
End If
End Sub
See if you can adapt that concept to your specific setup.
https://support.microsoft.com/en-us/help/235542/how-to-use-the-pivottable-office-web-component-with-vb

check if textbox exists vba (using name)

I am using Ms-Access and I created a userform which has a number of Textboxes on it. The boxes are named: Box1, Box2, Box3 ...
I need to loop through all boxes, but I don't know which is the last one. To avoid looping through all userform controls I thought of trying the following:
For i =1 To 20
If Me.Controls("Box" & i).value = MyCondition Then
'do stuff
End If
Next i
This errors at Box6, which is the first box not found. Is there a way to capture this error and exit the loop when it happens.
I know I could use On Error but I 'd rather capture this specific instance with code instead.
Thanks,
George
A Controls collection is a simplified collection of controls (obviously) and share a same order as a placement order of controls.
First of all, even a creatable collection object lacks methods such as Exists or Contains , hence you need a function with error handling to checking/pulling widget from a collection.
Public Function ExistsWidget(ByVal Name As String) As Boolean
On Error Resume Next
ExistsWidget = Not Me.Controls(Name) Is Nothing
On Error GoTo 0
End Function
If you really doesnt like "ask forgiveness not permission" option you can pull entire ordered collection of your textboxes (and/or check existance by name in another loop with similar logic).
Public Function PullBoxes() As Collection
Dim Control As MSForms.Control
Set PullBoxes = New Collection
For Each Control In Me.Controls
If TypeOf Control Is MSForms.TextBox And _
Left(Control.Name, 3) = "Box" Then
Call PullBoxes.Add(Control)
End If
Next
End Function
Since names of widgets are unique - you can return a Dictionary from that function with (Control.Name, Control) pairs inside and able to check existance of widget by name properly w/o an error suppression.
There's a good guide to Dictionary if it's a new information for you.
Anyway, no matter what object you choose, if user (or code) is unable to create more of thoose textboxes - you can convert this Function above to a Static Property Get or just to a Property Get with Static collection inside, so you iterate over all controls only once (e.g. on UserForm_Initialize event)!
Public Property Get Boxes() As Collection
Static PreservedBoxes As Collection
'There's no loop, but call to PullBoxes to reduce duplicate code in answer
If PreservedBoxes Is Nothing Then _
Set PreservedBoxes = PullBoxes
Set Boxes = PreservedBoxes
End Property
After all, the last created TextBox with name Box* will be:
Public Function LastCreatedBox() As MSForms.TextBox
Dim Boxes As Collection
Set Boxes = PullBoxes
With Boxes
If .Count <> 0 Then _
Set LastCreatedBox = Boxes(.Count)
End With
End Function
I think that now things are clearer to you! Cheers!
Note: All code are definitely a bunch of methods/properties of your form, hence all stuff should be placed inside of form module.
Long story short - you cannot do what you want with VBA.
However, there is a good way to go around it - make a boolean formula, that checks whether the object exists, using the On Error. Thus, your code will not be spoiled with it.
Function ControlExists(ControlName As String, FormCheck As Form) As Boolean
Dim strTest As String
On Error Resume Next
strTest = FormCheck(ControlName).Name
ControlExists = (Err.Number = 0)
End Function
Taken from here:http://www.tek-tips.com/viewthread.cfm?qid=1029435
To see the whole code working, check it like this:
Option Explicit
Sub TestMe()
Dim i As Long
For i = 1 To 20
If fnBlnExists("Label" & i, UserForm1) Then
Debug.Print UserForm1.Controls(CStr("Label" & i)).Name & " EXISTS"
Else
Debug.Print "Does Not exist!"
End If
Next i
End Sub
Public Function fnBlnExists(ControlName As String, ByRef FormCheck As UserForm) As Boolean
Dim strTest As String
On Error Resume Next
strTest = FormCheck(ControlName).Name
fnBlnExists = (Err.Number = 0)
End Function
I would suggest testing the existence in another procedure per below: -
Private Sub Command1_Click()
Dim i As Long
i = 1
Do Until Not BoxExists(i)
If Me.Conrtols("Box" & i).Value = MyCondition Then
'Do stuff
End If
i = i + 1
Next
End Sub
Private Function BoxExists(ByVal LngID As Long) As Boolean
Dim Ctrl As Control
On Error GoTo ErrorHandle
Set Ctrl = Me.Controls("BoX" & LngID)
Set Ctrl = Nothing
BoxExists = True
Exit Function
ErrorHandle:
Err.Clear
End Function
In the above, BoxExists only returns true if the box does exists.
You have taken an incorrect approach here.
If you want to limit the loop, you can loop only in the section your controls reside e.g. Detail. You can use the ControlType property to limit controls to TextBox.
Dim ctl As Control
For Each ctl In Me.Detail.Controls
If ctl.ControlType = acTextBox Then
If ctl.Value = MyCondition Then
'do stuff
End If
End If
Next ctl
I believe the loop will be faster than checking if the control name exists through a helper function and an On Error Resume Next.
But this only a personal opinion.

Trying to loop a search from Visual basic

I am trying to perform a search for a few rows of data in excel using visual basic.
Basically, search a website for each product...doesn't much matter if it opens multiple windows or tabs or whatever...nothing needs to be done with the webpages yet either. Here is my current attempt:
Private Sub CommandButton1_Click()
Dim index As Integer
index = 1
Dim searchme As String
While Worksheets("Sheet1").Cells(index, 1).Value <> Null
searchme = worsheets("Sheet1").Cells(index, 1).Value
searchmelink = "https://www.grainger.com/search?" & _
"searchBar=true&searchQuery=" & searchme
ThisWorkbook.FollowHyperlink Address:=searchmelink, NewWindow:=True
index = index + 1
End While
End Sub
I am getting an error at End While for some reason.
"Compile error:
Expected: If or Select or Sub or Function or Property or Type or With
or Enum or end of statement"
help me please, probably very simple but I'm new to this.
While is implemented like this:
While {test}
{actions}
Wend
or more typically:
Do While {test}
{actions}
Loop

VBA Outlook - read the current explorer search filter

I want to read the current filter of the Explorer.Search function.
I tried it with this code:
private sub read_old_filter()
dim objExplorer as Outlook.Explorer
dim oldFiler as String
set objExplorer = Outlook.ActiveExplorer
oldFilter = objExplorer.search
end sub
But objExplorer.search is a function, so it cant work.
I want to reuse the old filter. I have makros how filter for something like strFilter = "received:(today OR yesterday)".
And the private sub read_old_filter() is in my userform. I want to connect the old filter and the new filter of the userform.
Can anyone help me?
Thanks for any commend and answer. Kind reguards, Nico
This is obviously not directly possible in Outlook VBA. Although there is a ActiveExplorer.CurrentView.Filter as well as an XML property of the View, this will not expose the current filter query/condition.
However upon searching I came across this thread which is mentioning Redemption which seems to provide what you need:
How to get a search folder criteria in Outlook
Hope this helps.
I got a great Idea. I make in my Modul1 global values. In this values are the filter options of the macros.
I save with an Integer the current filter number. A Public Function read the Integer and with Select Case it pass the right filter to the userform.
Modul1
Const FILTER_1 As String = "" 'löscht alle filter
Const FILTER_2 As String = "followupflag:(followup flag)" 'zeigt nur Tasks an
Const FILTER_3 As String = "received:(today OR yesterday)" 'zeigt nur mails von heute und gestern
Dim filterUsed As Integer
'select right filter and save the number
Sub ViewFilter_all()
filterUsed = 1
Call filter_aktualisieren(FILTER_1)
End Sub
Sub onlyTasks()
filterUsed = 2
Call filter_aktualisieren(FILTER_2)
End Sub
Sub ViewFilter_today()
filterUsed = 3
Call filter_aktualisieren(FILTER_3)
End Sub
'search function for the macros
Private Sub filter_aktualisieren(strFilter As String)
Dim objExplorer As Object
Set objExplorer = Outlook.ActiveExplorer
objExplorer.search strFilter, Outlook.OlSearchScope.olSearchScopeCurrentFolder
objExplorer.Display
End Sub
'function to pass the filter to the userform
Public Function getFilterUsed() As String
Select Case filterUsed
Case 1
getFilterUsed = FILTER_1
Case 2
getFilterUsed = FILTER_2
Case 3
getFilterUsed = FILTER_3
Case Else
getFilterUsed = "none"
End Select
End Function
Part of Userform
Public Sub UserForm_Initialize()
'code....
'vorFilter is a Global String in my Userform
vorFilter = getFilterUsed()
'code....
End Sub
Hope the Solution help other People too.