Question

我现在要求将Outlook 2010中的公共共享文件夹中的所有日历导出到.csv，以便以后可以将其导入MS Access数据库。

我只拥有这些共享日历的查看权限，因此，大多数菜单选项都是淡入/无效的。我尝试了几个博客和插件，但没有任何作用。有没有办法让这种情况发生？如果没有，我必须手动将100多个日历逐个复制到个人.csvs，然后将粘贴复制到Excel，然后在MS Access中导入。

Answer 1

您可以考虑从Access自动化Outlook，而不是导出然后导入所需的数据。 How to automate Outlook from another program文章介绍了所有必需的步骤。

您可能会发现以下示例代码很有用（在VBA script to export Calendar to PST and CSV论坛帖子中列出）：

 Sub ExportAppointmentsToCSVFile()
  On Error Resume Next
  'You must set a reference to the Microsoft Scripting Runtime library to use the FileSystemObject
  Dim objNS As Outlook.NameSpace
  Dim objAppointments As Outlook.Items, objCalendarFolder As Outlook.MAPIFolder
  Dim objAppointment As Outlook.AppointmentItem
  Dim objFS As Scripting.FileSystemObject, objOutputFile As Scripting.TextStream
  Set objNS = Application.GetNamespace("MAPI")
  Set objCalendarFolder = objNS.GetDefaultFolder(olFolderCalendar)
  Set objAppointments = objCalendarFolder.Items
  Set objFS = New Scripting.FileSystemObject
  Set objOutputFile = objFS.OpenTextFile("C:\Temp\AppointmentExport.csv", ForWriting _
  , True)
  'Write header line 
  objOutputFile.WriteLine "Subject,Start,End"
  For Each objAppointment In objAppointments
    objOutputFile.WriteLine objAppointment.Subject & "," & objAppointment.Start & "," & objAppointment.End
  Next
  objOutputFile.Close
  Set objNS = Nothing
  Set objAppointment = Nothing
  Set objAppointments = Nothing
  Set objCalendarFolder = Nothing
  Set objFS = Nothing
  Set objOutputFile = Nothing
End Sub

Sub CopyItemsToFolder()
  On Error Resume Next
  Dim objNS As Outlook.NameSpace
  Dim objSourceItems As Outlook.Items
  Dim objSourceItem As Object, objCopy As Object
  Dim objSourceFolder As Outlook.MAPIFolder
  Dim objDestinationFolder As Outlook.MAPIFolder
  Dim blnCopyFolder As Boolean
  Set objNS = Application.GetNamespace("MAPI")
  MsgBox "In the next dialog, please select the source folder containing the items you want to copy...", vbOKOnly
  Set objSourceFolder = objNS.PickFolder
  If objSourceFolder Is Nothing Then GoTo Exitt: 'User cancelled
  If MsgBox("Do you wish to copy the entire folder? Click 'No' to copy just the contents of the folder. Otherwise, all subfolders" _
  & " will also be copied.", vbYesNo + vbQuestion, "Select Copy Type") = vbYes Then
    blnCopyFolder = True
    MsgBox "In the next dialog, please select the parent folder where you want the new folder copied to...", vbOKOnly
  Else
    MsgBox "In the next dialog, please select the destination folder where you want the folder items copied to...", vbOKOnly
  End If
  Set objDestinationFolder = objNS.PickFolder
  If objDestinationFolder Is Nothing Then GoTo Exitt: 'User cancelled
  If objDestinationFolder.DefaultItemType <> objSourceFolder.DefaultItemType Then
    If blnCopyFolder = False Then
      MsgBox "Please pick a destination folder that is of the same default item type as the source folder." _
      , vbOKOnly + vbExclamation, "Invalid Folder"
      GoTo Exitt:
    End If
  End If
  If blnCopyFolder = True Then
    objSourceFolder.CopyTo objDestinationFolder
  Else
    Set objSourceItems = objSourceFolder.Items
    For Each objSourceItem In objSourceItems
      Set objCopy = objSourceItem.Copy
      objCopy.Move objDestinationFolder
    Next
  End If
  MsgBox "Copy complete."
Exitt:
  Set objNS = Nothing
  Set objCopy = Nothing
  Set objSourceFolder = Nothing
  Set objSourceItem = Nothing
  Set objSourceItems = Nothing
  Set objDestinationFolder = Nothing
End Sub

如何批量将Outlook 2010中的所有公共共享日历导出到csv？

1 个答案: