If Statement to change field.control source - vba

I have a small If statement that that changes the controlsource of a field if another field is empty. The " just before = is incorrect, and I'm not sure what to use to ensure the entire string starting with the = is included.
Private Sub Report_Load()
If IsNull(FirstName2) Then
OwnersNames.ControlSource = "=FirstName1] & " " & [LastName1]"
Else
OwnersNames.ControlSource = "=[FirstName1] & " " & [LastName1] & " and " & [FirstName2] & " " & [LastName2]"
End If
End Sub

If I'm reading this correctly, then try this which uses more quote marks to concatenate the statement:
Private Sub Report_Load()
If IsNull(FirstName2) Then
OwnersNames.ControlSource = "=[FirstName1]" & " " & "[LastName1]"
Else
OwnersNames.ControlSource = "=[FirstName1]" & " " & "[LastName1]" & " and " & "[FirstName2]" & " " & "[LastName2]"
End If
End Sub

If you are trying to concatenate the fields (e.g. 'add' them together). You need something like:
Private Sub Report_Load()
If IsNull(FirstName2) Then
OwnersNames.ControlSource = "=[FirstName1] & ' ' & [LastName1]"
Else
OwnersNames.ControlSource = "=[FirstName1] & ' ' & [LastName1] & ' ' & [FirstName2] & ' ' & [LastName2]"
End If
End Sub
Keep in mind you can concatenate text fields (e.g. text boxes) together.
I'm uncertain if combining the control sources of fields works the same way. To be sure, one option is to rename each textbox to something different from its control source.

Here's the code now, which when loaded produces 'John Smith And' even though the Firstname2 field is null.
Private Sub Report_Load()
If Me.FirstName2 = vbNullString Then
OwnersNames.ControlSource = "=[FirstName1] & ' ' & [LastName1]"
Else
OwnersNames.ControlSource = "=[FirstName1] & ' ' & [LastName1] & ' and ' & [FirstName2] & ' ' & [LastName2]"
End If
End Sub

Are you really meaning to set the control source or just the value of the field?
I think this might be what you want to accomplish????
Private Sub Report_Load()
If Me.FirstName2 = "" Then
me.OwnersNames = [FirstName1] & " " & [LastName1]
Else
me.OwnersNames = [FirstName1] & " " & [LastName1] & _
" and " & [FirstName2] & " " & [LastName2]
End If
End Sub

Related

Select new Email by Subject and Date Range

I developed a macro to save attached files from selected emails with a subject depending on the body.
I would like to make the macro select the emails instead of doing it manually.
Goal: Select emails depending on their subject and an specific date range.
Filter mails received in a specified date range which corresponds with subject "Ordenes" and come from "ordenes#ordenes.com". This must be done without reading every single email on the inbox folder as I do not have the option of moving historical ones to another folder (shared email).
Select the mails that match the previous step and then call a macro called "SaveAttachements".
I've been checking Items.Restrict, Items.Find, Explorer.Selection, Explorer.AddToSelection but I don't seem to be getting the right concept.
You can filter (select) emails with .Restrict, which allows multiple conditions.
Option Explicit
Private Sub restrict_SenderEmailAddress_Subject_DateRangeRecent()
Dim itms As Items
Dim resItms As Items
Dim itm As Object
Dim srchSenderEmailAddress As String
Dim srchSubject As String
Dim dateRangeDays As Long
Dim srchDatePeriod As String
Dim strFilterBuild As String
Dim resItmsBuild As Items
Dim strFilter As String
Dim i As Long
Set itms = Session.GetDefaultFolder(olFolderInbox).Items
'For i = 1 To itms.Count
' Debug.Print itms(i).SenderEmailAddress
'Next
srchSenderEmailAddress = "ordenes#ordenes.com"
' If you cannot get the quotes right all at once, build the filter.
strFilterBuild = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email."
'MsgBox "No " & srchSenderEmailAddress & " email."
Exit Sub
End If
srchSubject = "Ordenes"
strFilterBuild = strFilterBuild & " And [Subject] = '" & srchSubject & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject
'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject
Exit Sub
End If
' adjust as needed
dateRangeDays = 1400
srchDatePeriod = Format(Date - dateRangeDays, "yyyy-mm-dd")
'Debug.Print srchDatePeriod
strFilterBuild = strFilterBuild & " And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
resItmsBuild.sort "[ReceivedTime]", True
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & dateRangeDays & " days."
'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & datePeriodDays & " days."
Exit Sub
End If
' This should match the final strFilterBuild to confirm it can be done all at once.
strFilter = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "' And [Subject] = '" & srchSubject & "' And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilter
Set resItms = itms.Restrict(strFilter)
resItms.sort "[ReceivedTime]", True
If resItms.Count = 0 Then
MsgBox "No " & srchSubject & " email on " & srchDatePeriod
End If
For i = 1 To resItms.Count
Debug.Print resItms(i).ReceivedTime & ": " & resItms(i).Subject
'SaveAttachments resItms(i)
Next
End Sub

Access report cannot be closed or refreshed from VB with updated parameter set

A form's button click opens an access report that comes up with data. The parameters are used with a pass-through query to an SQL stored procedure which returns records. The report does not come up Modal and I would like it to remain that way. However, if the user does not close the report before going back to the form and tries to set new parameters, the report remains open in the background and upon the button click the report is brought to the fore with old parameters and data and not refreshed with new parameters/data.
One option is to go Modal with the report but that makes for rough transitions with the user having to actively close the report. The other option is to close the report during retries which is what I have been trying. I have tried:
If CurrentProject.AllReports(rpt_ptq_uspWorkCentreReport).IsLoaded Then
DoCmd.Close acReport, rpt_ptq_uspWorkCentreReport, acSaveNo
in several different locations: _MousedDown, as the first If in the _Click, and _BeforeInsert. Each time CurrentProject.AllReports(rpt_ptq_uspWorkCentreReport).IsLoaded comes up false during the second pass when the report is sitting in the background and the form is being reworked with the next tries new parameters. Also during the second attempt the .OpenReport line fails with an SQL error because strSQLP1 is incomplete. Here's the _Click event:
Private Sub btnPreviewP1_Click()
If (Me.txtToDateP1 < Me.txtFromDateP1) Then
MsgBox ("The From Date must occurr before the To Date!")
End If
Dim strFromDateHMS As String
Dim strToDateHMS As String
Dim strSQLP1 As String
Dim strOpenArgs As String
strFromDateHMS = Format(Me.txtFromDateP1, "yyyy-mm-dd") & " " & Me.cboFromHourP1 & ":" & Me.cboFromMinuteP1 & ":" & Me.cboFromSecondP1
strToDateHMS = Format(Me.txtToDateP1, "yyyy-mm-dd") & " " & Me.cboToHourP1 & ":" & Me.cboToMinuteP1 & ":" & Me.cboToSecondP1
strSQLP1 = "exec dbo.uspWorkCentreReport '" & strFromDateHMS & "','" & strToDateHMS & "','" & strWCP1 & "'," & strShiftP1
strOpenArgs = Me.RecordSource & "|" & strFromDateHMS & "|" & strToDateHMS & "|" & strWCP1 & "|" & strShiftP1
' This line is all that's needed to modify the PT query
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQLP1
DoCmd.OpenReport "rpt_ptq_uspWorkCentreReport", acViewReport, , , , strOpenArgs
End Sub
And the _MouseDown where the .AllReports is currently:
Private Sub btnPreviewP1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If CurrentProject.AllReports(rpt_ptq_uspWorkCentreReport).IsLoaded Then
DoCmd.Close acReport, rpt_ptq_uspWorkCentreReport, acSaveNo
End If
End Sub
This is the Report_Open:
Private Sub Report_Open(Cancel As Integer)
Dim SplitOpenArgs() As String
SplitOpenArgs = Split(Me.OpenArgs, "|")
Me.lblFromDate.Caption = SplitOpenArgs(1)
Me.lblToDate.Caption = SplitOpenArgs(2)
Me.lblWC.Caption = SplitOpenArgs(3)
Me.lblShift.Caption = SplitOpenArgs(4)
End Sub
Why not just close report before OpenReport? I modified your code:
Private Sub btnPreviewP1_Click()
If (Me.txtToDateP1 < Me.txtFromDateP1) Then
MsgBox ("The From Date must occurr before the To Date!")
End If
Dim strFromDateHMS As String
Dim strToDateHMS As String
Dim strSQLP1 As String
Dim strOpenArgs As String
Dim R
strFromDateHMS = Format(Me.txtFromDateP1, "yyyy-mm-dd") & " " & Me.cboFromHourP1 & ":" & Me.cboFromMinuteP1 & ":" & Me.cboFromSecondP1
strToDateHMS = Format(Me.txtToDateP1, "yyyy-mm-dd") & " " & Me.cboToHourP1 & ":" & Me.cboToMinuteP1 & ":" & Me.cboToSecondP1
strSQLP1 = "exec dbo.uspWorkCentreReport '" & strFromDateHMS & "','" & strToDateHMS & "','" & strWCP1 & "'," & strShiftP1
strOpenArgs = Me.RecordSource & "|" & strFromDateHMS & "|" & strToDateHMS & "|" & strWCP1 & "|" & strShiftP1
' This line is all that's needed to modify the PT query
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQLP1
' Check if report is open and close it without saving:
For Each R In Reports
If R.Name = "rpt_ptq_uspWorkCentreReport" Then
DoCmd.Close acReport, "rpt_ptq_uspWorkCentreReport", acSaveNo
Exit For
End If
Next R
DoCmd.OpenReport "rpt_ptq_uspWorkCentreReport", acViewReport, , , , strOpenArgs
End Sub

Combobox filtering for listbox output is not working as expected

I have a few controls (Combobox's I call DDL's) that I use as filters for a dynamic query, shown below.
I have a region, division filter - and BCI/BCV/ABC/etc dropdowns.
When I select the region and division, the output list box correctly filters out everything except THOSE region/divisions. Good.
The problem comes in when I use the other DDL's, ABD/BCI/etc... those do not filter out correctly and I think it is with my and/or clauses below.
Can anyone see anything glaring or point me in the right direction to get this so that every control and ddl element filters out the data it is intended for - while keeping it in a format where the SQL itself is part of a string, like in my example?
Private Sub goBtn_Click()
strSQL = "SELECT [account_number], [BCI_Amt], [BCV_Amt],[ABC_Amt], [other_Amt], " & _
"[BCI_Amt]+[BCV_Amt]+[ABC_Amt]+[other_MRC_Amt], Division_Name, Region_Name, " & _
"Tier, Unit_ID, Name, Description_2 " & _
"FROM dbo_ndw_bc_subs " & _
"WHERE DivisionDDL = [Division_Name] and RegionDDL = [Region_Name] " & _
" and ( [BCI_Ind] = CheckBCI.value or [BCV_Ind] = CheckBCV.value or [ABC_Ind] = CheckABC.value " & _
" or BCIServiceDDL = [Tier]" & _
" or BCVServiceDDL = [Description_2]" & _
" or ABCServiceDDL = [Unit_ID] )" & _
"ORDER BY 6 asc"
Me.output1.RowSource = strSQL
End Sub
One of the combo box DDL control codes. There are check boxes that make the combo box visible or not visible.
Private Sub CheckBCV_Click()
If Me.CheckBCV = vbTrue Then
Me.BCVServiceDDL.Visible = True
Me.BCVServiceDDL = "Select:"
strSQL = "SELECT Distinct subs.[Description_2] FROM dbo_ndw_bc_subs "
Me.BCVServiceDDL.RowSource = strSQL
Me.BCVServiceDDL.Requery
Else
Me.BCVServiceDDL.Visible = False
Me.BCVServiceDDL = ""
End If
End Sub
Edit: Added additional code to the first code block for context, and updated some comments.
To reiterate the point of my question - Since some of the DDL's work as expected while the others do not. Is it in the AND/OR section where I have a problem - or am I forced to do an IF/IIF statement in the select. (And if I do this IF solution - how would that be incorporated into a string the way I have it now, I have not seen an example of this in my research on a resolution).
I think your top code sample should read more like this:
Private Sub goBtn_Click()
Dim strSQL As String
Dim strWhere As String
Dim strOp As String
strSQL = "SELECT [account_number], [BCI_Amt], [BCV_Amt],[ABC_Amt], [other_Amt], " & _
"[BCI_Amt]+[BCV_Amt]+[ABC_Amt]+[other_MRC_Amt], Division_Name, Region_Name, " & _
"Tier, Unit_ID, Name, Description_2 " & _
"FROM dbo_ndw_bc_subs "
strWhere = ""
strOp = ""
If Not IsNull(Me.DivisionDDL.Value) Then
strWhere = strWhere & strOp & "(Division_Name = """ & Me.DivisionDDL.Value & """)"
strOp = " And "
End If
If Not IsNull(Me.RegionDDL.Value) Then
strWhere = strWhere & strOp & "(Region_Name = """ & Me.RegionDDL.Value & """)"
strOp = " And "
End If
If Me.CheckBCI.Value Then
strWhere = strWhere & strOp & "(Tier = """ & Me.BCIServiceDDL.Value & """)"
strOp = " And "
End If
If Me.CheckBCV.Value Then
strWhere = strWhere & strOp & "(Description_2 = """ & Me.BCVServiceDDL.Value & """)"
strOp = " And "
End If
If Me.CheckABC.Value Then
strWhere = strWhere & strOp & "(Unit_ID = """ & Me.ABCServiceDDL.Value & """)"
strOp = " And "
End If
If Len(strWhere) > 0 then
strSQL = strSQL & " WHERE " & strWhere
End If
strSQL = strSQL & " ORDER BY 6 asc"
Me.output1.RowSource = strSQL
End Sub
This is wordier, but much closer to correct. P.S. I guessed that all values are strings. If not remove the quoting around non-string values.

Invalid qualifier Error Message in vba code

This code is designed to detect the columns of start and finish of a shape which is used and displayed onto the caption of the shape itself. The following code is the problematic code:
Sub Take_Baseline()
Dim forcast_weeksStart() As String
Dim forcast_weeksEnd() As String
Dim forcastDate As String
Dim shp As Shape
Dim split_text() As String
'cycle through all the shapes in the worsheet and enter the forcast date for all the projects into their respective boxes
For Each shp In ActiveSheet.Shapes
'initialize forcast date by parsing
forcast_weeksStart = Split(shp.TopLeftCell.Column.Text, " ")
forcast_weeksEnd = Split(shp.BottomRightCell.Column.Text, " ")
forcastDate = forcast_weeksStart(1) & "-" & forcast_weeksEnd(1)
temp = shp.OLEFormat.Object.Object.Caption
If InStr(temp, "/-/") > 0 & InStr(temp, "In Prog") Then
split_text = Split(shp.OLEFormat.Object.Caption, " ")
For i = 0 To (i = 3)
shp.TextFrame.Characters.Caption = split_text(i) & vbNewLine
Next i
ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption = ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption & vbNewLine & ActiveSheet.Cells(4, AShape.TopLeftCell.Column).Text & " - " & ActiveSheet.Cells(4, AShape.BottomRightCell.Column).Text & vbNewLine & "dates: " & forcast_weeksStart(1) & " - " & forcast_weeksEnd(1) & "/" & forcast_weeksStart(1) & " - " & forcast_weeksEnd(1) & "/" & "/" & "actualDate"
' ElseIf InStr(temp, "/-/") > 0 & InStr(temp, "In Prog") = 0 Then
'split_text = Split(shp.OLEFormat.Object.Object.Caption, " ")
' For i = 0 To (i = 2)
' shp.OLEFormat.Object.Caption = split_text(i) & vbNewLine
' Next i
'ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption = ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption & vbNewLine & "In Prog" & vbNewLine & ActiveSheet.Cells(4, AShape.TopLeftCell.Column).Text & " - " & ActiveSheet.Cells(4, AShape.BottomRightCell.Column).Text & vbNewLine & "dates: " & forcast_weeksStart(1) & " - " & forcast_weeksEnd(1) & "/" & forcast_weeksStart(1) & " - " & forcast_weeksEnd(1) & "/" & "actualDate"
End If
Next shp
'For testing purposes
Sheet4.Range("A20").Value = forcast_weeksStart(1)
Sheet4.Range("A21").Value = forcast_weeksEnd(1) End Sub
The error is an
"invalid qualifier"
message which occurs on line
forcast_weeksStart = Split(shp.TopLeftCell.Column.Text, " ")
Right on the "column" word. I don't get why this is happening since the actual drop down menu has the column operation which i can select. I have tried everything from changing it to the OLEformat.Object.Caption etc etc. But nothing has worked. I am still relatively new to vba so any help will be appreciated. Thanks

VBA If textbox is empty display all values

I have 2 textboxes and a button. The button opens a query with the values of the textboxes. Everything works fine, except when one textbox is empty then I want to find all the records from that textbox(So far I've tested it on textbox2). Here is my code:
Private Sub vbaBtn_Click()
Dim af1 As String, af2 As String
af1 = "([a1]='" + [krit1] + "') "
If krit2 = "" Then
af2 = "([a2]='" + "*" + "') "
Else
af2 = "([a2]='" + [krit2] + "') "
End If
DoCmd.OpenForm "FormLisategevusalad", acFormDS, , af1 & " " & "And" & " " & af2
End Sub
It seems to me, that VBA is always choosing the Else option not the If one, since when I debugged it said the error is an "Invalid use of null" and pointed to the Else condition.
Am I using a wrong method to detect and empty string? If I get the empty string recognition to work, is this af2 = "([a2]='" + "*" + "') " the right way to return all records?
Thanks in advance.
An empty textbox holds the value of Null, thus concatenating this with + results in a Null. Use &:
Private Sub vbaBtn_Click()
Dim af1 As String, af2 As String
af1 = "([a1]='" & [krit1] & "') "
If IsNull([krit2]) Then
af2 = "([a2] Is Not Null) "
Else
af2 = "([a2]='" & [krit2] & "') "
End If
DoCmd.OpenForm "FormLisategevusalad", acFormDS, ,af1 & " And " & af2
End Sub