Question

我是VBA的新手，正尝试从给定日期开始约会。为了避免重复，我尝试给单元格上色，但这似乎不可行，现在我希望进行代码检查是否存在与单元格相同的“主题”约会，如果存在，则转到下一行，如果没有创建约会。我收到错误必需的对象，并且无法为此找到可行的方法，或者甚至可能吗？非常感谢任何回复的人！

Private Sub Workbook_Open()
    Set myOutlook = CreateObject("Outlook.Application")
    r = 2

    Do Until Trim(Cells(r, 8).Value) = ""   
        If Cells(r, 9).Value = myapt.Subject = Cells(r, 9).Value Then
            r = r + 1      
        Else
            Set myapt = myOutlook.createitem(1)

            myapt.Subject = Cells(r, 9).Value
            myapt.Start = Cells(r, 8).Value
            myapt.AllDayEvent = True
            myapt.BusyStatus = 5
            myapt.ReminderSet = True
            'myapt.Body = ""
            myapt.Save

            Cells(r, 8).Interior.ColorIndex = 4
            r = r + 1
        End If    
    Loop
End Sub

Answer 1

要检查某个项目是否存在，您需要过滤现有项目：

final class NetworkManager {

    static let sharedInstance = NetworkManager.init()

    private var urlConfig: URLSessionConfiguration
    private var urlSession: URLSession

    var basePath : String = "https://api.myjson.com/";

    private init() {
        urlConfig = URLSessionConfiguration.default
        urlSession = URLSession(configuration: urlConfig)
    }

    //... rest of class

请注意，也许您想在Option Explicit Public Sub CreateItemsIfNotExist() Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("Sheet1") 'define your sheet! Dim olApp As Object 'create outlook application Set olApp = CreateObject("Outlook.Application") Dim olNS As Object 'get namespace Set olNS = olApp.GetNamespace("MAPI") 'define constants if using late binding Const olFolderCalendar As Long = 9 Const olAppointmentItem As Long = 1 Dim olRecItems As Object 'get all appointments Set olRecItems = olNS.GetDefaultFolder(olFolderCalendar) Dim strFilter As String 'filter for appointments Dim olFilterRecItems As Object 'filtered appointments Dim iRow As Long iRow = 2 Do Until Trim$(ws.Cells(iRow, 8).Value) = vbNullString 'filter appointments for subject strFilter = "[Subject] = '" & Trim$(ws.Cells(iRow, 9).Value) & "'" Set olFilterRecItems = olRecItems.Items.Restrict(strFilter) If olFilterRecItems.Count = 0 Then 'if subject does not exist With olApp.CreateItem(olAppointmentItem) .Subject = ws.Cells(iRow, 9).Value .Start = ws.Cells(iRow, 8).Value .AllDayEvent = True .BusyStatus = 5 .ReminderSet = True .Save End With ws.Cells(iRow, 8).Interior.ColorIndex = 4 End If iRow = iRow + 1 Loop End Sub结束时退出Outlook。

Excel VBA中的Outlook约会

1 个答案: