Okay, this is a little sloppy, but it seems to work.
Your tblRates should have: RateID, RoomCategory, DayOfWeek, and Price fields. If the names are different, you'll have to fix the code.
This was an interesting challenge!
Public Function DisplayRates(strCategory As String, datStart As Date, datEnd As Date, Optional intDisplayDates As Integer = 0) As String
Dim strDisplayRates As String, datNow As Date, curNow As Currency
Dim db As DAO.Database, rst As DAO.Recordset
Dim intDay As Integer, curRate As Currency, strDay As String, intNoPrice As Integer
Dim curPrevRate As Currency, datPrevDay As Date, intPrevDay As Integer, strDayCompare As String, strLongDayCompare As String
' Point to this database
Set db = CurrentDb
' Open the rates table
Set rst = db.OpenRecordset("SELECT * FROM tblRates")
' Loop through the dates
For datNow = datStart To datEnd - 1
' Get the day of the week of this date (Monday = 1)
intDay = Weekday(datNow, 2)
' Get the name of the day as an abbreviation
strDay = WeekdayName(intDay, True, 2)
' Look up the rate for this day
rst.FindFirst "RoomCategory = '" & strCategory & "' AND DayOfWeek = " & intDay
If rst.NoMatch Then
' Ooops - either an invalid category or the day isn't in the table
' Return error string
DisplayRates = "ERR - category or day of week not found."
' Get out
GoTo Bail
End If
curNow = rst!Price
' See if we got the same rate as previous
If curNow <> curPrevRate Then
' Need to update the return string
GoSub RateChange
' If this was the end of an entry,
If Right(strDisplayRates, 1) = ";" Then
' Change to today's date
curPrevRate = curNow
datPrevDay = datNow
intPrevDay = intDay
' Tell the sub to NOT add the price
intNoPrice = True
' And call it again to start the next one
GoSub RateChange
intNoPrice = False
End If
End If
' Save the current values
curPrevRate = curNow
datPrevDay = datNow
intPrevDay = intDay
' Loop
Next datNow
datPrevDay = datNow
intPrevDay = intDay
curPrevRate = curNow
' Process the last entry
GoSub RateChange
' Return the answer
DisplayRates = strDisplayRates
Bail:
' Close out
rst.Close
Set rst = Nothing
Set db = Nothing
Exit Function
RateChange:
' If string is empty,
If Len(strDisplayRates) = 0 Then
' Start of string, so just put in the date info
' If asked to display full date,
If intDisplayDates Then
' Put the full date in the string
strDisplayRates = Format(datNow, "Long Date")
Else
' Just put the day name
strDisplayRates = strDay
End If
Else
' Terminate the previous entry and put in the rate
' If this is a single date, string will end in ;
' .. and won't match the previous day name
If (Right(strDisplayRates, 1) <> ";") And _
(strLongDayCompare <> Format(datPrevDay, "Long Date")) And _
(strDayCompare <> WeekdayName(intPrevDay, True, 2)) Then
' Not a single date, so add a dash
strDisplayRates = strDisplayRates & " -"
End If
' Put in the date -
' But not if it matches what we did last time through!
If (strLongDayCompare <> Format(datPrevDay, "Long Date")) And _
(strDayCompare <> WeekdayName(intPrevDay, True, 2)) Then
If intDisplayDates Then
' Save for next time around
strLongDayCompare = Format(datPrevDay, "Long Date")
' Put the full date in the string
strDisplayRates = strDisplayRates & " " & strLongDayCompare
Else
' Save for next time around
strDayCompare = WeekdayName(intPrevDay, True, 2)
' Just put the day name
strDisplayRates = strDisplayRates & " " & strDayCompare
End If
End If
' Check to see if we need to add the price
If Not intNoPrice Then
' Add the price and end with a ;
strDisplayRates = strDisplayRates & " " & Format(curPrevRate, "$#,##0") & ";"
End If
End If
Return
End Function
John Viescas, Author
Effective SQL
SQL Queries for Mere Mortals
Microsoft Access 2010 Inside Out
Microsoft Access 2007 Inside Out
Microsoft Access 2003 Inside Out
Building Microsoft Access Applications
(Paris, France)
On Jan 31, 2017, at 6:49 AM, Lance Gallant istari.6@gmail.com [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:
Hi John
Of course! I see the logic of your proposed table structure. I'm going to change the tables accordingly.
I think I shall use an int for DayOfWeek corresponding to the result of Access' Weekday function (with Monday being the first day of the week).
You assume correctly that some help with the function would be appreciated :-)
Lance
John wrote:
Lance-
For starters, your prices table isn't normalized. I assume you price rooms by room category, so your pricing table should look like:
PriceID, RoomCategory, DayOfWeek, Price
Next, you need a function to which you pass parameters of arrival date, departure date, and room category. Your function can "walk" through the reservation dates, calculate the day of the week, and do a lookup into your pricing table. To print a generic report for Mon-Sun of any week, you would call the function with the date of any Monday and the date of any following Monday. That would allow you to use the same function to generate a price list for a specific room or a price list for any week.
I assume you need help writing the function … 😃
For starters, your prices table isn't normalized. I assume you price rooms by room category, so your pricing table should look like:
PriceID, RoomCategory, DayOfWeek, Price
Next, you need a function to which you pass parameters of arrival date, departure date, and room category. Your function can "walk" through the reservation dates, calculate the day of the week, and do a lookup into your pricing table. To print a generic report for Mon-Sun of any week, you would call the function with the date of any Monday and the date of any following Monday. That would allow you to use the same function to generate a price list for a specific room or a price list for any week.
I assume you need help writing the function … 😃
__._,_.___
Posted by: John Viescas <johnv@msn.com>
| Reply via web post | • | Reply to sender | • | Reply to group | • | Start a New Topic | • | Messages in this topic (4) |
Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.
.
__,_._,___
Tidak ada komentar:
Posting Komentar