Question

我想将我的数据从Excel电子表格导入非默认的Outlook日历。我创建了一个名为“MCalendar”的新子程序，但它不起作用 - 如果我将子程序的名称更改为“Calendar”，它只允许我使用默认日历。任何人都可以检查我的代码中是否缺少某些内容？我真的很感激。非常感谢！

 Option Explicit

 Sub calendar()
 Dim olApp As Object
 Dim olNs As Object
 Dim olStore As Object
 Dim olCal As Object
 Dim objAppt As Object
 Dim lastrow As Long
 Dim xlSheet As Worksheet
 Dim i As Long
 Dim strStart As String
 Dim strEnd As String
 Const strCalendar As String = "MCalendar"

 On Error Resume Next
 Set olApp = GetObject("Outlook.Application")
 If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
 On Error GoTo 0

 If Not olApp Is Nothing Then
 Set olNs = olApp.GetNamespace("MAPI")
 olNs.logon
 For Each olStore In olNs.Folders
  For Each olCal In olStore.Folders
    If olCal.Name = strCalendar Then
        Set xlSheet = Sheets("Sheet1")
            With xlSheet
                lastrow = xlSheet.Cells(Rows.Count, 1).End(xlUp).Row
                    For i = 2 To lastrow                        
                        strStart = xlSheet.Range("A" & i)
                        Set objAppt = olCal.Items.Add(1)
                            With objAppt
                                .Subject = xlSheet.Range("G" & i)                                    
                                .Save
                            End With
                    Next i

            End With
    Exit For
    Exit For

   End If
 Next olCal
 Next olStore
 End If
 lbl_Exit:
 Set objAppt = Nothing
 Set olCal = Nothing
 Set olStore = Nothing
 Set olApp = Nothing
 Set olNs = Nothing
 Exit Sub
 End Sub

将Excel数据导入非默认Outlook日历

0 个答案: