為記錄集范圍創建一個日歷事件

Question

我想弄清楚如何添加一個循環，該循環只會在每個 Markdown 結束日期創建一個 Outlook 日歷事件。

在我的表中，包號 6772457 在我的所有品牌優惠之間共享 Markdown 結束日期日期 2/9/2022 上午 8 點。 我想找到一種方法來為所有這些品牌優惠創建一個條目。

從邏輯上講，我在弄清楚如何進行循環以查看不同日期的多個包裝編號並創建事件時遇到了問題。

注意：記錄集可能有多個具有不同日期的包號，我想嘗試做到這一點，以便每個帶有日期的包號都有一個日歷事件。 我當前的代碼如下。

任何想法或朝着正確的方向推動將不勝感激！

包號	品牌優惠	Markdown 結束日期
6772457	W6	2/9/2022 上午 8:00:00
6772457	V6	2/9/2022 上午 8:00:00
6772457	S6	2/9/2022 上午 8:00:00
6772457	R6	2/9/2022 上午 8:00:00
6772457	P6	2/9/2022 上午 8:00:00

Private Sub Process_InSeason_Click()
Dim olobj As Outlook.Application
Dim oloappt As Outlook.AppointmentItem
Dim myOptionalAttendee As Outlook.Recipient
Dim PackNum As String
Dim rs As Dao.Recordset

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Define objects
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Appt = [Forms]![In Season MD Tracking]![InS_tbl_Original].[Form]![Markdown End Date].Value
Appt = DateSerial(Year(Appt), Month(Appt), Day(Appt))
Appt = Appt + TimeSerial(8, 0, 0)

PackNum = [Forms]![In Season MD Tracking]![InS_tbl_Original].[Form]![Pack_Number].Value

Set rs = CurrentDb.OpenRecordset("InS_tbl_Original")
Set olobj = CreateObject("Outlook.Application")
Set oloappt = olobj.CreateItem(olAppointmentItem)
Set myOptionalAttendee = oloappt.Recipients.Add("")
myOptionalAttendee.Type = olOptional

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Save records and turn on Error Control
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'DoCmd.RunCommand acCmdSaveRecord
On Error GoTo Add_Err

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Validate if Markdown End date is future date
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If rs.Fields("Markdown End Date").Value > Date Then

With oloappt
        .RequiredAttendees = myOptionalAttendee
        .Subject = "InSeason TEST" 'PackNum & " TEST"
        '.Body =
        .MeetingStatus = 1
        .ResponseRequested = True
        .Start = Appt
        .Duration = 10
        .ReminderSet = True
        .ReminderMinutesBeforeStart = 1440
        .Save
        '.Display
        .Send
        .Close (olSave)
End With
DoCmd.RunCommand acCmdSaveRecord
MsgBox "Appointment Added!"

Else 'do nothing
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'End process and clean up
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set oloappt = Nothing
Set olobj = Nothing

Exit Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Error validation
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Add_Err:
MsgBox "oops error found " & Err.Number & vbCrLf & Err.Description
Exit Sub

End Sub

Answer 1

我想到了。 為了完成這項工作，我在我的表中創建了一個查詢，該查詢將刪除重復的包號。 從那里我查看了查詢記錄。 對於試圖通過 Access 設置 outlook 事件的任何人，我想讓此代碼保持活動狀態。 希望這有幫助！