I am trying to use the dateadd function in Access 2007.
I am getting a compile error - "There was an error compiling this function. The Visual Basic module contains a syntax error.
DATEADD("w",2,[MyDateField])
I am not trying to use any VBA just adding 2 weekdays to a field in a query - Any help would be appreciated
DateAdd can only add days, not workdays. For that, a custom function is needed.
In a query, you can use my function, VDateAddWorkdays:
Select *, VDateAddWorkdays(2, [MyDateField]) As Date2
From YourTable
The function:
' Adds Number of full workdays to Date1 and returns the found date.
' Number can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are counted as workdays.
' Returns Null if any parameter is invalid.
'
' For excessive parameters that would return dates outside the range
' of Date, either 100-01-01 or 9999-12-31 is returned.
'
' Will add 500 workdays in about 0.01 second.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function VDateAddWorkdays( _
ByVal Number As Variant, _
ByVal Date1 As Variant, _
Optional ByVal WorkOnHolidays As Boolean) _
As Variant
Dim ResultDate As Variant
ResultDate = Null
If IsDateExt(Date1) Then
If IsNumeric(Number) Then
On Error Resume Next
ResultDate = DateAddWorkdays(CDbl(Number), CDate(Date1), WorkOnHolidays)
On Error GoTo 0
End If
End If
VDateAddWorkdays = ResultDate
End Function
As you can see, it takes advantage of some helper functions and a table holding holidays if those are to be taken into account as well.
Too much code to post here - the functions can be found in my project at GitHub: VBA.Date.
The specific modules needed will be:
DateBase
DateCalc
DateFind
DateWork
VDateWork
Related
I have 3 record:
day_birth of type Number (1-31);
month_birth of type Short Text ("January");
year_birth of type Number.
How to get in calculated field, full birthday day name from this day?
I tried this one expression:
WeekdayName(Weekday(DateSerial(2003;1;1);2))
But it doesn't work. I get #Type! in my record field.
Well, you can use this:
? format(dateserial(2003,1,1),"ddd")
Wed
or even this:
? format(dateserial(2003,1,1),"dddd")
Wednesday
However, you suggest/state/hint/imply/note that your input month is a LONG TEXT month of January. (short would be Jan).
So, we need to take into account that fact.
(but, why oh why oh why oh why oh why was the DOB not just stored as a simple single datetime column? With such a column, then you are 100% free to break it apart into 3 columns for reporting etc., but always have one simple date column
However, you have what you have, probably not your fault.
So, then:
Dim strTestMonth As String
Dim intTestYear As Integer
Dim intTestDay As Integer
strTestMonth = "January"
intTestYear = 2003
intTestDay = 1
Dim strTestDate As String
Dim strDateFormat As String
strDateFormat = "mmmm/dd/yyyy"
strTestDate = strTestMonth & "/" & intTestDay & "/" & intTestYear
Dim dtDate As Date
dtDate = Format(strTestDate, strDateFormat)
' get day of week as number
Debug.Print Weekday(dtDate)
' get day of week as text
Debug.Print "Short day of week = " & Format(dtDate, "ddd")
Debug.Print "Long day of week " & Format(dtDate, "dddd")
Output:
4
Short day of week = Wed
Long day of week Wednesday
So, approach:
Convert the string into a internal date, and once done, then you are free to spit out the date in any format you want, including use of weekday function, or even format which can return a short day format (wed), or a longer date format (Wednesday).
It not clear if you need this "display" of the week day on the form, or in a report or whatever. So as always the VERY important issue becomes the when/where/how/what point in time you need this expression.
So, you could for example place this function in a standard code module: (not forms code module)
Public Function GetDayOfWeek(strMonth As String, _
intDay As Integer, _
intYear As Integer) As String
Dim strDateFormat As String
Dim dtDate As Date
strDateFormat = "mmmm/dd/yyyy"
dtDate = Format(strMonth & "/" & intDay & "/" & intYear, strDateFormat)
GetDayOfWeek = Format(dtDate, "dddd")
End Function
So, now when ever and "where" ever you need to display the weekday as "text", then you can do this for even a control on that form:
=(GetDayOfWeek([MonthField],[dayField], [YearField]))
So, place the above code in a standard code module (not forms code module), and then in code, or even as a expression on a control in a form, you can pass the 3 values, and it will return/display the day of week in long text format.
Use DateValue and a simple query:
Select
*,
DateValue(Str([year_birth]) & " " & [month_birth] & Str([day_birth])) As BirthDate,
WeekdayName(Weekday(DateValue(Str([year_birth]) & " " & [month_birth] & Str([day_birth])), 2), 2) As BirthWeekday
From
YourTable
I am working on a code from a previous developer. This code has SystemTime set up.
Is there a way to get today date and minus 30 days in this format?
Code Below:
Public Function GetIsoTimestampTest() As String
Dim st As SYSTEMTIME
'Get the local date and time
GetSystemTime st
'Format the result
GetIsoTimestampTest = _
Format$(st.wYear, "0000") & "-" & _
Format$(st.wMonth, "00") & "-" & _
Format$(st.wDay, "00") & "T" & _
Format$(st.wHour, "00") & ":" & _
Format$(st.wMinute, "00") & ":" & _
Format$(st.wSecond, "00") & "Z"
End Function
Build a native date & time, add -30 days, format as a string:
utcInIsoFormat = Format$(DateAdd("d", -30, _
DateSerial(st.wYear, st.wMonth, st.wDay) _
+ TimeSerial(st.wHour, st.wMinute, st.wSecond)), "yyyy-mm-ddThh:nn:ssZ")
SYSTEMTIME appears to be a custom type defined elsewhere in your code. It's not a standard type available in Access VBA. So to use it effectively, you need to find the definition. Also GetSystemTime is also likely a custom function exclusive to your code. Here's a sample definition of a similar type, although it may not be exactly what's implemented in your system: http://custom-designed-databases.com/wordpress/2011/get-milliseconds-or-seconds-from-system-time-with-vba/
That said, System Time would refer to the Windows system time. You also have a native ability in VBA to get time using the Now() function. (https://msdn.microsoft.com/en-us/library/office/gg278671.aspx) This returns a variable with type Date, which is equivalent to a number where the integer represents days and the decimal represents time of day. An example to get 30 days prior to today would be:
Dim lastMonth as Date
Dim formattedDate as String
lastMonth = Now() - 30
formattedDate = Format(lastMonth, "yyyy-mm-ddThh:nn:ssZ")
DateSerial happily accepts a negative day count. Thus:
Public Function IsoDateMinus30() As Date
Dim st As SYSTEMTIME
Dim Result As Date
' Get the local date and time
GetSystemTime st
Result = DateSerial(st.wYear, st.wMonth, st.wDay - 30)
' To include time:
'
' Result = _
' DateSerial(st.wYear, st.wMonth, st.wDay - 30) + _
' TimeSerial(st.wHour, st.wMinute, st.wSecond)
IsoDateMinus30 = Result
End Function
I have a vb6 project. It was developed by senior. Now I want to change the existing code. I am new for vb6. The database file like ini format. Actually he worked with access database. I want to create some tables in this database. Please give any idea to open ini file in access database or any idea to open ini file.
Oh my, this is old stuff:
Jose 's VB Tips & Tricks
Using Initialization Files
To paraphrase the great American author Mark Twain, reports of the demise
of .ini files have been greatly exaggerated.
While Microsoft has proclaimed the registry to be the proper storehouse of
initialization information, .ini files still have their uses. Among the
advantages of .ini files are:
The files are easily "human readable" using any simple text editor
such as Notepad.
The API code for working with .ini files is considerably simpler than
the equivalent registry APIs.
Files can be easily opened over a network with nothing more than a
basic redirector installed on either end.
Installation of an .ini file is as simple as copying the file to the
Windows directory.
Windows provides a variety of APIs for working with .ini files, including
the GetProfileXXX and WriteProfileXXX functions dedicated to working with
win.ini and the following functions for reading and writing private
initialization files:
GetPrivateProfileString
Read a string from an .ini file.
GetPrivateProfileInt
Read an integer from an .ini file.
WritePrivateProfileString
Write a string to an .ini file.
WritePrivateProfileInt
Write an integer to an .ini file.
Given, however, that all of the data in .ini files is plain old text,
there 's really no need to separately code the xxxInt versions of these
functions. Converting a string to an Int in VB is simple enough using the
CInt() or Val() function, so only the GetPrivateProfileString and
WritePrivateProfileString functions are needed.
Both of these are simple API calls. There is one exception case when
reading .ini files that return a C string with multiple values separated by
Nulls. To parse that string, I've included the MultiCStringToStringArray
function.
Before continuing, you 'll need to add two Declares to the declarations
section of a module somewhere. As a matter of habit, I alias Win32 APIs
with "w32_" so that I can write a VB wrapper function and give it the name
of the API function.
Here 's the declarations section:
Option Explicit
Private Declare Function w32_GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" ( _
ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Private Declare Function w32_WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpString As Any, _
ByVal lpFileName As String) As Long
Here 's the code for GetPrivateProfileString:
Public Function GetPrivateProfileString( _
psAppName As String, _
psKeyName As String, _
Optional pvsDefault As Variant, _
Optional pvsFileName As Variant) As String
'********************
' Purpose: Get a string from a private .ini file
' Parameters:
' (Input)
' psApplicationName - the Application name
' psKeyName - the key (section) name
' pvsDefault - Default value if key not found (optional)
' pvsFileName - the name of the .ini file
' Returns: The requested value
' Notes:
' If no value is provided for pvsDefault, a zero-length string is used
' The file path defaults to the windows directory if not fully qualified
' If pvsFileName is omitted, win.ini is used
' If vbNullString is passed for psKeyName, the entire section is returned in
' the form of a multi-c-string. Use MultiCStringToStringArray to parse it after appending the
' second null terminator that this function strips. Note that the value returned is all the
' key names and DOES NOT include all the values. This can be used to setup multiple calls for
' the values ala the Reg enumeration functions.
'********************
' call params
Dim lpAppName As String
Dim lpKeyName As String
Dim lpDefault As String
Dim lpReturnedString As String
Dim nSize As Long
Dim lpFileName As String
' results
Dim lResult As Long
Dim sResult As String
sResult = ""
' setup API call params
nSize = 256
lpReturnedString = Space$(nSize)
lpAppName = psAppName
lpKeyName = psKeyName
' check for value in file name
If Not IsMissing(pvsFileName) Then
lpFileName = CStr(pvsFileName)
Else
lpFileName = "win.ini"
End If
' check for value in optional pvsDefault
If Not IsMissing(pvsDefault) Then
lpDefault = CStr(pvsDefault)
Else
lpDefault = ""
End If
' call
' setup loop to retry if result string too short
Do
lResult = w32_GetPrivateProfileString( _
lpAppName, lpKeyName, lpDefault, lpReturnedString, nSize, lpFileName)
' Note: See docs for GetPrivateProfileString API
' the function returns nSize - 1 if a key name is provided but the buffer is too small
' the function returns nSize - 2 if no key name is provided and the buffer is too small
' we test for those specific cases - this method is a bit of hack, but it works.
' the result is that the buffer must be at least three characters longer than the
' longest string(s)
If (lResult = nSize - 1) Or (lResult = nSize - 2) Then
nSize = nSize * 2
lpReturnedString = Space$(nSize)
Else
sResult = Left$(lpReturnedString, lResult)
Exit Do
End If
Loop
GetPrivateProfileString = sResult
End Function
Here 's WritePrivateProfileString:
Public Function WritePrivateProfileString( _
psApplicationName As String, _
psKeyName As String, _
psValue As String, _
psFileName As String) As Boolean
'********************
' Purpose: Write a string to an ini file
' Parameters: (Input Only)
' psApplicationName - the ini section name
' psKeyName - the ini key name
' psValue - the value to write to the key
' psFileName - the ini file name
' Returns: True if successful
' Notes:
' Path defaults to windows directory if the file name
' is not fully qualified
'********************
Dim lResult As Long
Dim fRV As Boolean
lResult = w32_WritePrivateProfileString( _
psApplicationName, _
psKeyName, _
psValue, _
psFileName)
If lResult <> 0 Then
fRV = True
Else
fRV = False
End If
WritePrivateProfileString = fRV
End Function
And finally, here's MultiCStringToStringArray:
Public Sub MultiCStringToStringArray(psMultiCString As String, psaStrings() As String)
'Created: Joe Garrick 01/06/97 9:28 AM
'********************
' Purpose: Convert a multi-string C string to an array of strings
' Parameters:
' (Input)
' psMultiCString - the multiple C string
' (Output)
' psaStrings - returned array of strings
' Notes:
' The original array should be empty and ReDim-able
'********************
Dim iNullPos As Integer
Dim iPrevPos As Integer
Dim iIdx As Integer
' initialize array, setting first element to a zero-length string
iIdx = 0
ReDim psaStrings(0 To iIdx + 1)
psaStrings(iIdx + 1) = ""
Do
' find null char
iNullPos = InStr(iPrevPos + 1, psMultiCString, vbNullChar)
' double null encountered if next pos is old pos + 1
If iNullPos > iPrevPos + 1 Then
' assing to the string array
psaStrings(iIdx) = Mid$(psMultiCString, (iPrevPos + 1), ((iNullPos - 1) - iPrevPos))
iIdx = iIdx + 1
ReDim Preserve psaStrings(0 To iIdx)
iPrevPos = iNullPos
Else
' double null found, remove last (empty) element and exit
ReDim Preserve psaStrings(0 To iIdx - 1)
Exit Do
End If
Loop
End Sub
that 's all there is to coding .ini files.
Notes
Check the SDK documentation for the specifics of behavior of these
functions.
If you send a zero-length string to the write function, the key is
removed.
If you attempt to write a value for a key that does not exist or a
section that does not exist, the key or section will be created.
Despite Microsoft's portrayal of the registry as the central
repository for configuration information under Win95, win.ini and
system.ini are still used, so exercise caution when working with these
files (in other words, make a backup before you experiment).
GetPrivateProfileString returns the requested data, but
WritePrivateProfileString returns a boolean indicating success or
failure. While GetPrivateProfileString is highly reliable, it could
easily be modified to return a Boolean or some other type of status
code indicating the result.
If you use GetPrivateProfileString to return an entire section,
remember to add an additional null (string & vbNullChar will do it)
before calling MultiCStringToStringArray since that function expects
two nulls to terminate the string. Also, keep in mind that only the
key names are returned, not the values.
Return to Top of Page [Return to top of page]
| Home | Jose's World of Visual Basic | Jose's VB Tips & Tricks |
| © 1997 Joe Garrick | Info Center | [E-mail]jgarrick#citilink.com |
So my project is to calculate a list of deadlines for various items based off a conference start date. I have been trying to figure out how to use Access 2007 (employer software) to generate the due dates based off a change in the conference start date.
My failures include:
Write Conflict Message <-- trying to get rid of this
Not recognizing the variable
Tried a Query, but couldn't get the query to show in the Form
ConferenceStartDate is the column containing the user input on the Form, and the variable I want to base all other dates on. I have the Form use the "Before Update" subroutine to make the change.
Private Sub ConferenceStartDate_BeforeUpdate(Cancel As Integer)
' Concept is to enter Volume and Conference Date Start/End and have it calculate the rest of the dates
' Then compare to current date and create a report on over due, next due, etc
' Then create emails based on templates for next data
Dim rstNameList As DAO.Recordset
Set rstNameList = Application.CurrentDb.OpenRecordset("Table1", dbOpenDynaset)
Dim startDate As Date
Dim endDate As Date
Dim recordNumber As Integer
Dim stringRecordNumber As String
Dim stringSQL As String
' *** Second Attempt
' Gives Write Conflict message. Weird, if you say Update, moving to the next record does not update, but saying No Update actually updates the record.
recordNumber = [ID]
stringRecordNumber = "ID=" & CStr(recordNumber)
' Gets the start date of the conference
startDate = [ConferenceStartDate]
' Add seven "d"ays tp startDate
endDate = DateAdd("d", 7, startDate)
' rstNameList.FindFirst stringRecordNumber
' rstNameList.Edit
'rstNameList!VolumeName = "MC-130"
' rstNameList!ConferenceStartDate = startDate
' rstNameList!ConferenceEndDate = endDate
' rstNameList.Update
' rstNameList.Close
' Gets rid of the Write Conflict error message
' Command doesnt work
' If Forms("Table1").Dirty Then Forms("Table1").Dirty = False
' *** First Attempt
'Works to add
'Set db = CurrentDb
'Set rs = db.OpenRecordset("Table1")
'rs.AddNew
'rs("ID") = 5
'rs("VolumeName") = "KC-130"
'rs("ConferenceStartDate") = "1/1/1111"
'rs("ConferenceEndDate") = "1/2/1212"
'rs.Update
'rs.Close
' *** Third Attempt
' Doesn't actually update
' stringSQL = "UPDATE Table1 SET [ConferenceEndDate] = #" & CStr(endDate) & "# WHERE " & stringRecordNumber
' DoCmd.RunSQL stringSQL
End Sub
Any one have any idea how to not have a Write Conflict Message and the dates update based of input from a Form of a single date?
Thanx!
If your form is bound to a table then you shouldn't be trying to use SQL statements to update the current record in the form. As you have found, that can lead to write conflicts because two "processes" are trying to update the same record at the same time.
Instead, you should create bound controls for the fields you want to update (making them hidden, if necessary) and then update the values of those controls.
I typically have some need to run a process each day prior to my arrival at the office. I would like to set this up as a scheduled task.
How can this be accomplished?
Is there a best practice on doing this?
Can or should this be done programmatically?
To resolve this I did the following:
Created a Macro named "Submit".
Created a Scheduled task .job file by going to:
Start > All Programs > Accessories > System Tools > Schedule Tasks
(This produced the .job file in the following location: "C:\WINDOWS\Tasks\Submit.job")
Once this was created, I placed the following syntax into the Run: text box.
"C:\Program Files\Microsoft Office\Office11\MSACCESS.EXE" "C:\MyDatabasePath\MyDatabaseName.mdb" /x "Submit"
After this, the remaining portion of the setup is completed as a normal schedule task should be. You can find more details about how to manually setup these tasks [here][2] or if you like to perform the setup through the command line, this is a particularly useful reference.
Note: Both the Macro and the job file must be setup for this to work correctly.
One way to accomplish this programmatically would be do utilize the job API's. Here is one such example where this was accomplished using VBA:
See Reference Here
Option Explicit
' Schedule api's
Declare Function NetScheduleJobAdd Lib "netapi32.dll" _
(ByVal Servername As String, Buffer As Any, Jobid As Long) As Long
' Schedule structure
Type AT_INFO
JobTime As Long
DaysOfMonth As Long
DaysOfWeek As Byte
Flags As Byte
dummy As Integer
Command As String
End Type
' Schedule constants
Const JOB_RUN_PERIODICALLY = &H1
Const JOB_NONINTERACTIVE = &H10
Const NERR_Success = 0
Private Sub Command1_Click()
Dim lngWin32apiResultCode As Long
Dim strComputerName As String
Dim lngJobID As Long
Dim udtAtInfo As AT_INFO
' Convert the computer name to unicode
strComputerName = StrConv(Text1.Text, vbUnicode)
' Setup the tasks parameters
SetStructValue udtAtInfo
' Schedule the task
lngWin32apiResultCode = NetScheduleJobAdd(strComputerName, udtAtInfo, lngJobID)
' Check if the task was scheduled
If lngWin32apiResultCode = NERR_Success Then
MsgBox "Task" & lngJobID & " has been scheduled."
End If
End Sub
Private Sub SetStructValue(udtAtInfo As AT_INFO)
Dim strTime As String
Dim strDate() As String
Dim vntWeek() As Variant
Dim intCounter As Integer
Dim intWeekCounter As Integer
vntWeek = Array("M", "T", "W", "TH", "F", "S", "SU")
With udtAtInfo
' Change the format of the time
strTime = Format(Text2.Text, "hh:mm")
' Change the time to one used by the api
.JobTime = (Hour(strTime) * 3600 + Minute(strTime) * 60) * 1000
' Set the Date parameters
If Val(Text3.Text) > 0 Then
' Set the task to run on specific days of the month i.e. 9th & 22nd of the month
strDate = Split(Text3.Text, ",")
For intCounter = 0 To UBound(strDate)
.DaysOfMonth = .DaysOfMonth + 2 ^ (strDate(intCounter) - 1)
Next
Else
' Set the task to run on sepecific days of the week i.e. Monday & Thursday
strDate = Split(Text3.Text, ",")
For intCounter = 0 To UBound(strDate)
For intWeekCounter = 0 To UBound(vntWeek)
If UCase(strDate(intCounter)) = vntWeek(intWeekCounter) Then
.DaysOfWeek = .DaysOfWeek + 2 ^ intWeekCounter
Exit For
End If
Next
Next
End If
' Set the interactive property
If Check1.Value = vbUnchecked Then
.Flags = .Flags Or JOB_NONINTERACTIVE
End If
' Set to run periodically
If Option2.Value = True Then
.Flags = .Flags Or JOB_RUN_PERIODICALLY
End If
' Set the command to run
.Command = StrConv(Text4.Text, vbUnicode)
End With
End Sub
If the tasks do not run appropriately, it may be due to updates in software and/or service packs. Check the program files for Microsoft Office and Access. "Office11" as shown in the run line may need to be changed to "Office 14" or "Office12" depending on the folders showing in program files.