¦p¦ó¥Hµ{¦¡³]­p¤è¦¡±q Access ¶×¤J Outlook ¶µ¥Ø

Sub ExportAccessContactsToOutlook()

   ' Set up DAO Objects.
   Dim oDataBase As DAO.Database
   Dim rst As DAO.Recordset
   Set oDataBase = OpenDatabase _
      ("c:\Program Files\Microsoft Office\Office10\Samples\Northwind.mdb")
   Set rst = oDataBase.OpenRecordset("Customers")

   ' Set up Outlook Objects.
   Dim ol As New Outlook.Application
   Dim olns As Outlook.Namespace
   Dim cf As Outlook.MAPIFolder
   Dim c As Outlook.ContactItem
   Dim Prop As Outlook.UserProperty

   Set olns = ol.GetNamespace("MAPI")
   Set cf = olns.GetDefaultFolder(olFolderContacts)

   With rst
      .MoveFirst

      ' Loop through the Microsoft Access records.
      Do While Not .EOF

         ' Create a new Contact item.
         Set c = ol.CreateItem(olContactItem)

         ' Specify which Outlook form to use.
         ' Change "IPM.Contact" to "IPM.Contact.<formname>" if you've
         ' created a custom Contact form in Outlook.
         c.MessageClass = "IPM.Contact"

         ' Create all built-in Outlook fields.
         If ![CompanyName] <> "" Then c.CompanyName = ![CompanyName]
         If ![ContactName] <> "" Then c.FullName = ![ContactName]

         ' Create the first user property (UserField1).
         Set Prop = c.UserProperties.Add("UserField1", olText)

         ' Set its value.
         If ![CustomerID] <> "" Then Prop = ![CustomerID]

         ' Create the second user property (UserField2).
         Set Prop = c.UserProperties.Add("UserField2", olText)

         ' Set its value and so on....
         If ![Region] <> "" Then Prop = ![Region]

         ' Save and close the contact.
         c.Save
         c.Close

         .MoveNext
      Loop
   End With

End Sub