Help importing contact information to Exchange via vbs and SQL Server

  • I have been doing my best to get the following vbs code to work:

    set mySourceConn = CreateObject("ADODB.Connection")

    set rst = CreateObject("ADODB.Recordset")

    mySourceConn.Open = "Provider=SQLOLEDB.1;Data Source=192.168.200.16;Initial Catalog=Northwind;user id = '';password="

    mySQLCmdText = "dbo.Customers"

    rst.Open mySQLCmdText, mySourceConn

       Set ol = CreateObject("Outlook.Application")

       Set olns = ol.GetNamespace("MAPI")

        

       Set cf = olns.Folders.Item("Public Folders"). _

                Folders.Item("All Public Folders"). _

                Folders.Item("Contacts_IGCR")

        

       With rst

       rst.MoveFirst

      

          ' Loop through the records

          Do While Not .EOF

           

            Set c = cf.Items.Add(olContactItem)

            c.MessageClass = "IPM.Contact"

            If rst.Fields("ContactName") <> "" Then c.CompanyName = rst.Fields("ContactName")

            c.Save

            rst.MoveNext

          Loop

       End With

    The code supposed to import contact information from SQL and create a contact in Exchange

    I think the problem is with how I am using the Outlook methods/objects

    Please help

  • When I run this code in DTS:

    ===================================================

    Function Main()

    set mySourceConn = CreateObject("ADODB.Connection")

    set rst = CreateObject("ADODB.Recordset")

    mySourceConn.Open = "Provider=SQLOLEDB.1;Data Source=;Initial Catalog=Northwind;user id =;password="

    mySQLCmdText = "dbo.Customers"

    rst.Open mySQLCmdText, mySourceConn

       Set ol = CreateObject("Outlook.Application")

       Set olns = ol.GetNamespace("MAPI")

        

       Set cf = olns.Folders.Item("Public Folders").Folders.Item("All Public Folders").Folders.Item("Contacts_IGCR")

       With rst

       rst.MoveFirst

      

          ' Loop through the records

          Do While Not rst.EOF

           

     Set c = cf.Items.Add(olContactItem)

       

            c.MessageClass = "IPM.Contact.frmContacts_IGCR"

         If rst.Fields("ContactName") <> "" Then c.FullName = rst.Fields("ContactName")

            c.Save

            rst.MoveNext

          Loop

       End With

     Main = DTSTaskExecResult_Success

    End Function

    ===================================================

    I get the following message:

    Task failed:

    Error Code: 0

    Error Source=Microsoft VBScript runtime error

    Error Description: Invalid procedure call or argument: 'cf.Items.Add'

     

    Please help

     

Viewing 2 posts - 1 through 1 (of 1 total)

You must be logged in to reply to this topic. Login to reply