This is the first bit of my VB.NET code:
Private Function CreateEventMWB(pWeek As XmlNode, sEventSettings As GoogleEventSettings, strEventType As String, ByRef rbCreated As Boolean) As My_GoogleEvent
Dim sEvent As My_GoogleEvent
sEvent.strTitle = pWeek.Attributes(kEventTitle).Value()
sEvent.strDate = pWeek.Attributes(kDate).Value()
sEvent.strTime = pWeek.Attributes(kStartTime).Value()
sEvent.strLocation = GetXmlNodeText(pWeek, kSpecialEventLocation)
sEvent.iMeetingDuration = 105 ' 1h 45m
sEvent.bSpecialEvent = GetXmlNodeBoolean(pWeek, kSpecialEvent)
sEvent.bNoMeeting = GetXmlNodeBoolean(pWeek, kNoMeeting)
sEvent.bFirstWeekOfMonth = GetXmlNodeBoolean(pWeek, kFirstWeek)
sEvent.strTag1 = strEventType
sEvent.strTag2 = ""
sEvent.strEventDetails = ""
rbCreated = False
If (Not sEvent.bNoMeeting) Then
' It does not matter if this is a special event (like a circuit visit meeting)
' as it is still a meeting
rbCreated = True
ElseIf (Not sEventSettings.bExcludeSpecialEvents) Then
' We already know there is no meeting for this date.
' Therefore it is going to be a special event. But are we including special events? - Yes!
rbCreated = True
End If
If (rbCreated) Then
' We have one of two scenariors
' 1. It is a normal meeting or a special meeting
' 2. It is a special event (if they were not excluded)
Dim bCreateAsMeeting = True
If (sEvent.bSpecialEvent And sEvent.bNoMeeting) Then
bCreateAsMeeting = False
End If
If (bCreateAsMeeting) Then
AddToEventDetails(sEvent, "IDS_TPL_MWB_GOOGLE_NOTE", sEventSettings.dictLabels, GetXmlNodeText(pWeek, kNote))
The variable sEvent gets correctly filled. The program works - always has done. But the last call in the code AddToEventDetails raises a warning when I compile:
I am not sure exactly how I can prevent the warning.
Thank you.
Related
syntax error on the area of code E at the start 6th line
Private Sub Combo21_AfterUpdate()
' Update the row source of the cboProducts combo box
' when the user makes a selection in the cboCategories
' combo box.
Dim mybuyprice, myproduct, myunits
**E If DLookup("[Buy Price]", "GoodsIn_Buy_Price") = Null Then mybuyprice = "0" Else mybuyprice = DLookup("[Buy Price]", "GoodsIn_Buy_Price")
Me.Buy_Price = mybuyprice**
If DLookup("[Product]", "GoodsIn_Buy_Price") = Null Then myproduct = "Null" Else myproduct = DLookup("[Product]", "GoodsIn_Buy_Price")
Me.Product = myproduct
If DLookup("[Unit of Measure]", "Product_Unit_Check") = Null Then myunits = "0" Else myunits = DLookup("[Unit of Measure]", "Product_Unit_Check")
Me.Unit = myunits
Me.Refresh
You have a bunch of repeated logic which would be better factored out into a separate function:
Private Sub Combo21_AfterUpdate()
' Update the row source of the cboProducts combo box when the
' user makes a selection in the cboCategories combo box.
Me.Buy_Price = IfNull(DLookup("[Buy Price]", "GoodsIn_Buy_Price"), "0")
Me.Product = IfNull(DLookup("[Product]", "GoodsIn_Buy_Price"), "Null")
Me.Unit = IfNull(DLookup("[Unit of Measure]", "Product_Unit_Check"), "0")
Me.Refresh
End Sub
'return `exp` if it's not Null, otherwise return `default`
Function IfNull(exp, default)
If IsNull(exp) Then
IfNull = default
Else
IfNull = exp
End If
End Function
See also https://codekabinett.com/rdumps.php?Lang=2&targetDoc=coalesce-function-paramarray-keyword-vba-argument for a more flexible version.
I use ms access vba to create my program and I don't like default msgbox design , so I create a form named "frm_msg"
look like this >>>
and I make a simple function with arguments to call this form
Public Function custom_msg(msg_title, msg_txt, msg_icon, msg_button As String)
DoCmd.OpenForm "frm_msg"
Form_frm_msg.lbl_msg_title.Caption = msg_title
Form_frm_msg.lbl_msg_txt.Caption = msg_txt
If msg_icon = "success_icon" Then
Form_frm_msg.success_icon.Visible = 1
Form_frm_msg.error_icon.Visible = 0
Form_frm_msg.warning_icon.Visible = 0
Form_frm_msg.question_icon.Visible = 0
ElseIf msg_icon = "error_icon" Then
Form_frm_msg.success_icon.Visible = 0
Form_frm_msg.error_icon.Visible = 1
Form_frm_msg.warning_icon.Visible = 0
Form_frm_msg.question_icon.Visible = 0
ElseIf msg_icon = "warning_icon" Then
Form_frm_msg.success_icon.Visible = 0
Form_frm_msg.error_icon.Visible = 0
Form_frm_msg.warning_icon.Visible = 1
Form_frm_msg.question_icon.Visible = 0
ElseIf msg_icon = "question_icon" Then
Form_frm_msg.success_icon.Visible = 0
Form_frm_msg.error_icon.Visible = 0
Form_frm_msg.warning_icon.Visible = 0
Form_frm_msg.question_icon.Visible = 1
End If
If msg_button = "ok" Then
Form_frm_msg.btn_ok.Visible = 1
Form_frm_msg.btn_yes.Visible = 0
Form_frm_msg.btn_no.Visible = 0
ElseIf msg_button = "yes_no" Then
Form_frm_msg.btn_ok.Visible = 0
Form_frm_msg.btn_yes.Visible = 1
Form_frm_msg.btn_no.Visible = 1
End If
End Function
now my problem is how do I make it return a value depending on the button that I click?
and use it like default msgbox in if statement
if msgbox("Hallo world",vbInformation+ vbYesNo ,"Hallo") = vbYes Then
'do something ...
end if
The easiest way I found to do this reliably is to place a hidden text box on the form to hold your 'return' value. (I found this more reliable as you can control default value, type etc and draw conclusions from NULL etc which you can't from using a TempVar)
Now write yourself a simple wrapper function which opens the form in dialog mode. In the OnClick event of your buttons, set the hidden text control value to the return value you want, and then hide (don't close) the form. Because it was dialog, it will still be open but not visible, and control flow returns to your wrapper function.
Obtain the value from the hidden text field on the form using a fully qualified reference to the text control, store it in a variable in the wrapper function and do something with it if required, or just return it as is (like the example), then close the form programmatically using DoCmd.Close.
Something simple like this;
Form_Name is the full name of your form
NameOfTextControl is the name of the hidden control set by your onClick event
Function customBox(msg_title, msg_txt, msg_icon, msg_button) as string
'I would usually pass a delimited string of values in the OpenArgs
'or set TempVars if necessary, then use your function code inside
'the form Open event to configure the form dynamically before displaying
DoCmd.OpenForm "Form_Name", acNormal, , , , acDialog
' When we get back here, the form is invisible, not closed
customBox = Forms!Form_Name!NameOfTextControl
DoCmd.Close acForm, "Form_Name", acSaveNo
End Function
So all you then do is replace msgbox with your customBox function and adjust the vbYes / vbNo constant to check for whatever value you set in the form
if customBox(msg_title, msg_txt, msg_icon, msg_button) = "Yes" Then
'do something ...
end if
You can use a module and global/public variables to interact with the form.
Here is a snippet from my project:
' Opens a message box, using form ModernBox, similar to VBA.MsgBox.
'
' Syntax. As for MsgBox with an added parameter, TimeOut:
' MsgMox(Prompt, [Buttons As VbMsgBoxStyle = vbOKOnly], [Title], [HelpFile], [Context], [TimeOut]) As VbMsgBoxResult
'
' If TimeOut is negative, zero, or missing:
' MsgMox waits forever as MsgBox.
' If TimeOut is positive:
' MsgMox exits after TimeOut milliseconds, returning the result of the current default button.
'
' 2018-04-26. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function MsgMox( _
Prompt As String, _
Optional Buttons As VbMsgBoxStyle = vbOkOnly, _
Optional Title As Variant = Null, _
Optional HelpFile As String, _
Optional Context As Long, _
Optional TimeOut As Long) _
As VbMsgBoxResult
' Set global variables to be read by form ModernBox.
mbButtons = Buttons
mbPrompt = Prompt
mbTitle = Title
mbHelpFile = HelpFile
mbContext = Context
Call OpenFormDialog(ModernBoxName, TimeOut)
' Return result value set by form ModernBoxName.
MsgMox = mbResult
End Function
The full code is way too much to post here, so feel free to browse VBA.ModernBox for all the details.
K Access guru's. I have a module that requery's a main form, then set's a filter based on a value in a field, and requery's the subforms with that filter. The problem is when I set subform.FilterOn = True, it doesnt do anything and returns False. I'd rather not upload the whole solution. But heres a screenshot of the code with the highlighted part showing the discrepancy. Below is the code for copy/paste purposes. Why is this not working?
Private Sub Combo7_AfterUpdate()
Dim strSQL As String
Application.Echo False
strSQL = "[APN] = " & Str(Nz(Me![Combo7], 0))
DoCmd.ApplyFilter wherecondition:=strSQL
Me![Combo22].Requery
Me![Combo22] = Me![Text24]
Dim val As String
Dim subform1 As Form
Dim subform2 As Form
Dim subform3 As Form
val = Me![Text24]
Set subform1 = Me.qPayment_subform.Form
Set subform2 = Me.qRefundWriteOff_subform.Form
Set subform3 = Me.qRetnCHK_subform.Form
subform1.FilterOnLoad = True
subform2.FilterOnLoad = True
subform3.FilterOnLoad = True
subform1.FilterOn = True
subform2.FilterOn = True
subform3.FilterOn = True
subform1.Filter = "PeriodID = " & val
subform2.Filter = "PeriodID = " & val
subform3.Filter = "PeriodID = " & val
subform1.Requery
subform2.Requery
subform3.Requery
Application.Echo True
End Sub
Give subform container control a name different from the object it holds. For instance, if the form is named frmOrderDetails name the container ctrDetails. Then maybe using the container name in setting the object variables will work. If not, consider eliminating the variables and just referencing the container name.
With Me
...
.ctrDetails.Form.FilterOn = True
...
End With
I know this means repeating .Form but it will be fast edit.
In any case, set the Filter property before FilterOn.
Also, FilterOnLoad and Requery are not necessary.
I have an excel workbook where the user imports text files into a "Data Importation Sheet". The number of files imported is dependent on how files the user wants to import. So far my workbook works great but I have hit one bump. When the user imports a file an identifier (i.e. 1, 2, 3, etc) gets assigned to that data set. Then the user selects an option from a dropdown box and calculations and plots will automatically be produced. The user also has the option to "Clear all data" where when this is selected all worksheets are cleared and if the user imports new files (after clicking the "clear all data" button) the identifier value restarts at 1. Here is my code for the identifier/counting how many files have been imported..
Public Sub Macro(Optional reset As Boolean = False)
Static i As Integer
If reset Then
i = -1
i = i + 1
Exit Sub
End If
i = i + 1
Worksheets("Hidden").Cells(i + 1, 1).FormulaR1C1 = "=" & i
Worksheets("Hidden").Cells(2, 2).FormulaR1C1 = "=" & i
End Sub
The problem I have ran into now is data will need to be imported into this sheet at a later date so when I save this file and reopen it then import more files the identifier/count for file imports restarts at 1 which I do not want to happen. I want to be able to just keep adding more files and have the code continue, I do not want to have to clear all the imported data and restart. Any ideas as to how I can do this? TIA.
I'd create a standalone function to manage the sequence. Store the value in a Workbook Name entry.
Note - if you had to manage multiple sequences you could promote the name of the sequence to a parameter instead of using a Constant within the Function.
Function NextSequence(Optional reset As Boolean = False)
Const COUNTER_NAME As String = "NM_COUNTER"
Dim nm As Name, i
On Error Resume Next
'is the name already created?
Set nm = ThisWorkbook.Names(COUNTER_NAME)
On Error GoTo 0
If nm Is Nothing Then
'not there yest - create it...
Set nm = ThisWorkbook.Names.Add(COUNTER_NAME, 0)
End If
If Not reset Then
i = Evaluate(nm.RefersTo)
i = i + 1
nm.RefersTo = i
Else
nm.RefersTo = 0
i = 0 '<< or 1 if you want NextSequence(True) to
' return the first sequence value
End If
NextSequence = i
End Function
Usage:
Public Sub Macro(Optional reset As Boolean = False)
Dim i
i = NextSequence(reset)
If reset Then Exit Sub
With Worksheets("Hidden")
.Cells(i + 1, 1).Value = i
.Cells(2, 2).Value = i
End With
End Sub
A quick fix for this would be to store the value of the identifier/count inside a cell and hide/lock the cell. The value inside the cell won't change upon restart yet you still can manipulate it inside VBA.
Very quick feel of how it should look like (probably innacurate as I don't have every info I need.)
Public Sub Macro(Optional reset As Boolean = False)
Static i As Integer
i = ActiveWorkBook.Sheets("Ressource").Range("A1").Value
If reset Then
i = -1
i = i + 1
Exit Sub
End If
i = i + 1
Worksheets("Hidden").Cells(i + 1, 1).FormulaR1C1 = "=" & i
Worksheets("Hidden").Cells(2, 2).FormulaR1C1 = "=" & i
End Sub
You could also create a CustomDocumentProperty to save the sequence number. You can pass a boolean to the method to reset:
Lastly, a helper function will check if the property exists, in order to be added if not.
Public Sub SequenceNumber(Optional ByVal Reset As Boolean = False)
If Not PropertyExists("Identifier") Then
ThisWorkbook.CustomDocumentProperties.Add Name:="Identifier", _
LinkToContent:=False, _
Type:=msoPropertyTypeNumber, _
Value:=0
End If
Dim p As Object
Set p = ThisWorkbook.CustomDocumentProperties("Identifier")
If Reset Then p.Value = 0 Else p.Value = p.Value + 1
End Sub
'Property Exists?
Private Function PropertyExists(ByVal propertyName As String) As Boolean
Dim p As Object
For Each p In ThisWorkbook.CustomDocumentProperties
If p.Name = propertyName Then
PropertyExists = True
Exit Function
End If
Next p
End Function
To call it:
SequenceNumber
SequenceNumber Reset:=True
I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.