使用VB脚本从Outlook联系人导出自定义字段 [英] Exporting Custom Fields from Outlook Contacts Using VB Script

问题描述

我有成功将Outlook联系信息导出到csv文件的代码，但我看不出如何导出自定义字段。

I have code that successfully exports outlook contact information to a csv file but I cannot see how I can export custom fields.

有什么建议吗？

这是我的代码：

Sub SaveContactsinFile()

On Error GoTo ErrorHandling

Dim MyCount As Long
MyCount = 1
Dim MyType As String

    Dim objOutlook As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder
    Dim olItems As Outlook.Items
    Dim olContact As Outlook.ContactItem
    
   Dim objFS As New Scripting.FileSystemObject, objFile As Scripting.TextStream
   Dim strFile As String
   Dim sName As String
  
        Set objNS = Application.GetNamespace("MAPI")

‘ folder named clients 
        Set objFolder = objNS.Folders.Item("[e-mail]").Folders("Clients")

' ===============
' Get file ready -
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
 
‘ generate random file number 
' add the current date to the filename
sName = Format(Now(), "yyyymmdd")

 'random number avoids file exists error
   intHigh = 10000
   intLow = 1
 Randomize
   intNumber = Int((intHigh - intLow + 1) * Rnd + intLow)

‘ContactsFolderLocation= constant holding output folder location
MyFileLocation = ContactsFolderLocation
If Right(MyFileLocation, 1) <> "\" Then
    MyFileLocation = MyFileLocation & "\"
End If

  strFile = MyFileLocation & sName & "- Contacts " & intNumber & ".csv"
  

  Set objFile = objFS.CreateTextFile(strFile, False)
  If objFile Is Nothing Then
    MsgBox "Error creating export contacts file '" & strFile & "'.", vbOKOnly + vbExclamation _
      , "Invalid File"
    Exit Sub
  End If
  
  ' headings to be inserted into csv file
   With objFile
    .Write "Company" & "," & "Email1 Address" & "," & "Email1 Display Name" & "," & "Full Name" & "," & "Arable"
    .Write vbCrLf
 End With
' ==================

Set olItems = objFolder.Items

 For Each olContact In olItems

        MyType = olContact.MessageClass
            
            ' actual field data
                With objFile
‘ will not work when custom field names Arable included
                    '.Write olContact.CompanyName & "," & olContact.Email1Address & "," & olContact.Email1DisplayName & "," & olContact.FullName & "," & olContact.Arable

‘ works fine when no custom field required
                    .Write olContact.CompanyName & "," & olContact.Email1Address & "," & olContact.Email1DisplayName & "," & olContact.FullName

                   .Write vbCrLf
                End With
                
    MyCount = MyCount + 1
   
Nextone:
Next


    objFile.Close
   
    Set objNS = Nothing
    Set objFolder = Nothing
    Set olItems = Nothing
    Set olContact = Nothing

    Set objFS = Nothing
    Set objFile = Nothing
    
Exit Sub


ErrorHandling:
' error occurs when contact entry is a distribution list
If Err.Number = 13 Then
    Resume Nextone
Else
    MsgBox Err.Number & " " & Err.Description
End If
   
End Sub

推荐答案

嗨Keith，

Hi Keith,

我正在将您的主题转移到以下专用Outlook for developer论坛，你应该得到更专业的回应：

I'm moving your thread to the following dedicated Outlook for developer forum, there you should get more professional response:

https://social.msdn.microsoft.com/Forums/en-us/home?forum=outlookdev

我们建议适当发布的原因是你会得到最合格的受访者群体以及定期阅读论坛的其他合作伙伴可以分享他们的知识，也可以从与我们的互动中学习。感谢您的理解。

The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.

问候，

Ethan Hua

Ethan Hua

这篇关于使用VB脚本从Outlook联系人导出自定义字段的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！