C
chaser12
can anybody know how to start programming with writing vb code, access to
outlook public folder, my files in access.
outlook public folder, my files in access.
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
S
Sue Mosher [MVP-Outlook]
If you're new to Outlook automation, these web pages should help you get started:
http://www.winnetmag.com/Articles/Index.cfm?ArticleID=21522&pg=1
http://www.outlookcode.com/d/vb.htm
http://www.winnetmag.com/Articles/Index.cfm?ArticleID=21522&pg=1
http://www.outlookcode.com/d/vb.htm
C
chaser12
I have this code and giving me error Did not find Contacts from Access folder
-- exiting. why can not find it, Ihave created folder in my personal folder
called contacts, am I not correct?
Set nms = Application.GetNamespace("MAPI")
strFolder = "Contacts from Access"
'Check for existence of Contacts from Access folder
fFound = False
FindFolder nms.Folders("Personal Folders").Folders, 0, strFolder
If fFound = False Then
MsgBox "Did not find Contacts from Access folder -- exiting"
Exit Sub
End If
-- exiting. why can not find it, Ihave created folder in my personal folder
called contacts, am I not correct?
Set nms = Application.GetNamespace("MAPI")
strFolder = "Contacts from Access"
'Check for existence of Contacts from Access folder
fFound = False
FindFolder nms.Folders("Personal Folders").Folders, 0, strFolder
If fFound = False Then
MsgBox "Did not find Contacts from Access folder -- exiting"
Exit Sub
End If
S
Sue Mosher [MVP-Outlook]
What does the FindFolder procedure do?
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
C
chaser12
Function FindFolder(Parent, Depth, ShortName)
Dim Root
Root = "Personal"
For Each fld In Parent
If fld.Name = strFolder Then
fFound = True
Exit Function
End If
Next
End Function
I think this code written by vb script, and I want vb, I don't know what do
i need to do?
Dim Root
Root = "Personal"
For Each fld In Parent
If fld.Name = strFolder Then
fFound = True
Exit Function
End If
Next
End Function
I think this code written by vb script, and I want vb, I don't know what do
i need to do?
S
Sue Mosher [MVP-Outlook]
That function will never set fFound to True, since it has an undeclared variable strFolder that is never instantiated. You could change strFolder to ShortName to get it to work at least partway. Or, you might want instead to use the function at http://www.outlookcode.com/d/code/getfolder.htm and pass it a complete path string and have it return the actual folder. Or, if you want to work with the default Contacts folder, use the Namespace.GetDefaultFolder method.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
C
chaser12
in this code what I need to do, it doesn't like MAPIFolder
Public Function GetFolder(ByVal strFolderPath As String) As MAPIFolder
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
objApp = CreateObject("Outlook.Application")
objNS = objApp.GetNamespace("MAPI")
objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
colFolders = objFolder.Folders
objFolder = Nothing
objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
GetFolder = objFolder
colFolders = Nothing
objNS = Nothing
objApp = Nothing
End Function
Public Function GetFolder(ByVal strFolderPath As String) As MAPIFolder
' folder path needs to be something like
' "Public Folders\All Public Folders\Company\Sales"
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long
On Error Resume Next
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
objApp = CreateObject("Outlook.Application")
objNS = objApp.GetNamespace("MAPI")
objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
colFolders = objFolder.Folders
objFolder = Nothing
objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
GetFolder = objFolder
colFolders = Nothing
objNS = Nothing
objApp = Nothing
End Function
S
Sue Mosher [MVP-Outlook]
And where are you running this code? If in Access VBA, then you need to add a reference to the Outlook library.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
C
chaser12
This is my another code, that only problem here is all the way buttom it
doesn't like fld, it says it is not defined, even though i did defined up top
of the code, anyway, how can I get rid of this fld thing because you
suggested that try to put different folder? can you point out where and what
i need to put that folder? I am running this in vb.
Sub Main()
Dim rst
Dim dao
Dim wks
Dim db
Dim nms
Dim fld
Dim itms
Dim itm
Dim strAccessDir
Dim objAccess
Dim strFolder
Dim fFound
Dim objApp As Outlook.Application
Dim ooo As Outlook.ContactItem
'nms = objApp.GetNamespace("MAPI")
nms = objApp.Namespace.getdefaultfolder
strFolder = "Contacts from Access"
'Check for existence of Contacts from Access folder
'fFound = False
FindFolder(nms.Folders("Personal Folders").Folders, 0, strFolder)
'If fFound = False Then
' MsgBox("Did not find Contacts from Access folder -- exiting")
' Exit Sub
'End If
'Pick up path to Access database directory from Access SysCmd function
objAccess = ooo.CreateObject("Access.Application")
strAccessDir = objAccess.SysCmd(9)
Dim strDBName = strAccessDir & "Contacts.mdb"
'MsgBox "DBName: " & strDBName
objAccess.Quit()
'Set up reference to Access database
dao = objApp.CreateObject("DAO.DBEngine.35")
wks = DAO.Workspaces(0)
db = wks.OpenDatabase(strDBName)
'Open Access table containing data to import into Outlook
rst = db.OpenRecordset("tblCustomers")
Dim RecCount = rst.RecordCount
If RecCount = 0 Then
MsgBox("No customers to import")
Exit Sub
Else
MsgBox(RecCount & " customers to import")
End If
'Set up the Outlook folder and items and iterate
'through the Access table, adding one contact item using
'the custom form for each Access record
nms = objApp.GetNamespace("MAPI")
fld = nms.Folders("Personal Folders").Folders("Contacts from Access")
itms = fld.Items
Do Until rst.EOF
'MsgBox "Importing " & rst.ContactName & "'s record"
itm = itms.Add("IPM.Contact.Access Contact")
'Built-in Outlook properties
itm.CustomerID = rst.CustomerID
itm.CompanyName = rst.CompanyName
itm.FullName = rst.ContactName
itm.BusinessAddressStreet = rst.Address
itm.BusinessAddressCity = rst.City
itm.BusinessAddressState = rst.Region
itm.BusinessAddressPostalCode = rst.PostalCode
'If IsNull(rst.Country) = False Then itm.BusinessAddressCountry
= rst.Country
itm.BusinessTelephoneNumber = rst.Phone
itm.BusinessFaxNumber = rst.Fax
itm.JobTitle = rst.ContactTitle
'Custom Outlook properties
itm.UserProperties("Preferred") = rst.Preferred
itm.UserProperties("Discount") = rst.Discount
itm.Close(0)
rst.MoveNext()
Loop
rst.Close()
MsgBox("All contacts imported!")
End Sub
doesn't like fld, it says it is not defined, even though i did defined up top
of the code, anyway, how can I get rid of this fld thing because you
suggested that try to put different folder? can you point out where and what
i need to put that folder? I am running this in vb.
Sub Main()
Dim rst
Dim dao
Dim wks
Dim db
Dim nms
Dim fld
Dim itms
Dim itm
Dim strAccessDir
Dim objAccess
Dim strFolder
Dim fFound
Dim objApp As Outlook.Application
Dim ooo As Outlook.ContactItem
'nms = objApp.GetNamespace("MAPI")
nms = objApp.Namespace.getdefaultfolder
strFolder = "Contacts from Access"
'Check for existence of Contacts from Access folder
'fFound = False
FindFolder(nms.Folders("Personal Folders").Folders, 0, strFolder)
'If fFound = False Then
' MsgBox("Did not find Contacts from Access folder -- exiting")
' Exit Sub
'End If
'Pick up path to Access database directory from Access SysCmd function
objAccess = ooo.CreateObject("Access.Application")
strAccessDir = objAccess.SysCmd(9)
Dim strDBName = strAccessDir & "Contacts.mdb"
'MsgBox "DBName: " & strDBName
objAccess.Quit()
'Set up reference to Access database
dao = objApp.CreateObject("DAO.DBEngine.35")
wks = DAO.Workspaces(0)
db = wks.OpenDatabase(strDBName)
'Open Access table containing data to import into Outlook
rst = db.OpenRecordset("tblCustomers")
Dim RecCount = rst.RecordCount
If RecCount = 0 Then
MsgBox("No customers to import")
Exit Sub
Else
MsgBox(RecCount & " customers to import")
End If
'Set up the Outlook folder and items and iterate
'through the Access table, adding one contact item using
'the custom form for each Access record
nms = objApp.GetNamespace("MAPI")
fld = nms.Folders("Personal Folders").Folders("Contacts from Access")
itms = fld.Items
Do Until rst.EOF
'MsgBox "Importing " & rst.ContactName & "'s record"
itm = itms.Add("IPM.Contact.Access Contact")
'Built-in Outlook properties
itm.CustomerID = rst.CustomerID
itm.CompanyName = rst.CompanyName
itm.FullName = rst.ContactName
itm.BusinessAddressStreet = rst.Address
itm.BusinessAddressCity = rst.City
itm.BusinessAddressState = rst.Region
itm.BusinessAddressPostalCode = rst.PostalCode
'If IsNull(rst.Country) = False Then itm.BusinessAddressCountry
= rst.Country
itm.BusinessTelephoneNumber = rst.Phone
itm.BusinessFaxNumber = rst.Fax
itm.JobTitle = rst.ContactTitle
'Custom Outlook properties
itm.UserProperties("Preferred") = rst.Preferred
itm.UserProperties("Discount") = rst.Discount
itm.Close(0)
rst.MoveNext()
Loop
rst.Close()
MsgBox("All contacts imported!")
End Sub
S
Sue Mosher [MVP-Outlook]
Your code is difficult to follow because it uses multiple statements to set the value of the same variables. For example, this statement is incomplete:
nms = objApp.Namespace.getdefaultfolder
I think what you want is:
Set nms = objApp.GetNamespace("MAPI")
Set fld = nms.GetDefaultFolder(olFolderContacts)
Remember that in VB6, you need to use a Set statement to set an object variable. That will apply to your DAO objects, too. Of course, if you're using VB.NET not VB6 or VBA, we need to know that right up front.
But then you have different nms and fld statements later:
nms = objApp.GetNamespace("MAPI")
fld = nms.Folders("Personal Folders").Folders("Contacts from Access")
Both of these should be fine if you prefix them with the Set keyword and if there really is a Contacts from Access folder in the Personal Folders hierarchy.
TIP: When posting here, remove commented out code lines and clearly indicate which code statements are causing problems.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
nms = objApp.Namespace.getdefaultfolder
I think what you want is:
Set nms = objApp.GetNamespace("MAPI")
Set fld = nms.GetDefaultFolder(olFolderContacts)
Remember that in VB6, you need to use a Set statement to set an object variable. That will apply to your DAO objects, too. Of course, if you're using VB.NET not VB6 or VBA, we need to know that right up front.
But then you have different nms and fld statements later:
nms = objApp.GetNamespace("MAPI")
fld = nms.Folders("Personal Folders").Folders("Contacts from Access")
Both of these should be fine if you prefix them with the Set keyword and if there really is a Contacts from Access folder in the Personal Folders hierarchy.
TIP: When posting here, remove commented out code lines and clearly indicate which code statements are causing problems.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
C
chaser12
I found in outlook called this outlook session, it is running vb project, I
have tried this , then I have vb.net also, and I tried that too, both times
it is giving me errors all the time, i am very confused, and cannot access to
my folder called contacts in public folders. For example, is it good to run
my code in outlook session? or stick with vb.net? also, what is "Of course,
if you're using VB.NET not VB6 or VBA, we need to know that right up front.
But then you have different nms and fld statements later:
nms = objApp.GetNamespace("MAPI")
fld = nms.Folders("Personal Folders").Folders("Contacts from Access")
Both of these should be fine if you prefix them with the Set keyword and if
there really is a Contacts from Access folder in the Personal Folders
hierarchy. "
i have folder called contacts yes in personal and public folders still
doesn't find it either of them.
have tried this , then I have vb.net also, and I tried that too, both times
it is giving me errors all the time, i am very confused, and cannot access to
my folder called contacts in public folders. For example, is it good to run
my code in outlook session? or stick with vb.net? also, what is "Of course,
if you're using VB.NET not VB6 or VBA, we need to know that right up front.
But then you have different nms and fld statements later:
nms = objApp.GetNamespace("MAPI")
fld = nms.Folders("Personal Folders").Folders("Contacts from Access")
Both of these should be fine if you prefix them with the Set keyword and if
there really is a Contacts from Access folder in the Personal Folders
hierarchy. "
i have folder called contacts yes in personal and public folders still
doesn't find it either of them.
S
Sue Mosher [MVP-Outlook]
The code syntax and likely errors are going to be different depending on which code environment you choose to use. Therefore, I would suggest that you decide on one environment to code in and stick with it ... and tell us which you're using. We can't help without that information. Post that, your latest code snippet, and the text of any error messages you are receiving. Please omit the database access portion of the code, since it's not relevant to the immediate issue and will only add clutter.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
C
chaser12
I am running this in vb.net console applications and it is running fine, but
i don't know where is the result. It is giving some data, but I can't even
see it because it is fast, then after done, I don't know where is my data
went. HOw can i make it to go public folders, contact folder
Sub Main()
' Create Outlook application.
Dim oApp As Outlook.Application = New Outlook.Application
' Get namespace and Contacts folder reference.
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim cContacts As Outlook.MAPIFolder =
oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
' Get the first contact from the Contacts folder.
Dim oItems As Outlook.Items = cContacts.Items
Dim oCt As Outlook.ContactItem
Dim iCount As Int16
iCount = 0
oCt = oItems.GetFirst()
Do While Not oCt Is Nothing
iCount += 1
' Display some common properties.
Console.WriteLine(oCt.FullName)
Console.WriteLine(oCt.Title)
Console.WriteLine(oCt.Birthday)
Console.WriteLine(oCt.CompanyName)
Console.WriteLine(oCt.Department)
' Console.WriteLine(oCt.Body)
Console.WriteLine(oCt.FileAs)
'This next statement will display an Address
'Security warning. For more information, see the
'security information in the article at the end of this
'article titled "What's New in Microsoft Office
'Outlook 2003 for Developers"?
'Console.WriteLine(oCt.Email1Address)
Console.WriteLine(oCt.BusinessHomePage)
Console.WriteLine(oCt.MailingAddress)
Console.WriteLine(oCt.BusinessAddress)
Console.WriteLine(oCt.OfficeLocation)
Console.WriteLine(oCt.Subject)
Console.WriteLine(oCt.JobTitle)
oCt = oItems.GetNext
Loop
Console.WriteLine(iCount)
' Clean up.
oApp = Nothing
oItems = Nothing
oCt = Nothing
End Sub
i don't know where is the result. It is giving some data, but I can't even
see it because it is fast, then after done, I don't know where is my data
went. HOw can i make it to go public folders, contact folder
Sub Main()
' Create Outlook application.
Dim oApp As Outlook.Application = New Outlook.Application
' Get namespace and Contacts folder reference.
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim cContacts As Outlook.MAPIFolder =
oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
' Get the first contact from the Contacts folder.
Dim oItems As Outlook.Items = cContacts.Items
Dim oCt As Outlook.ContactItem
Dim iCount As Int16
iCount = 0
oCt = oItems.GetFirst()
Do While Not oCt Is Nothing
iCount += 1
' Display some common properties.
Console.WriteLine(oCt.FullName)
Console.WriteLine(oCt.Title)
Console.WriteLine(oCt.Birthday)
Console.WriteLine(oCt.CompanyName)
Console.WriteLine(oCt.Department)
' Console.WriteLine(oCt.Body)
Console.WriteLine(oCt.FileAs)
'This next statement will display an Address
'Security warning. For more information, see the
'security information in the article at the end of this
'article titled "What's New in Microsoft Office
'Outlook 2003 for Developers"?
'Console.WriteLine(oCt.Email1Address)
Console.WriteLine(oCt.BusinessHomePage)
Console.WriteLine(oCt.MailingAddress)
Console.WriteLine(oCt.BusinessAddress)
Console.WriteLine(oCt.OfficeLocation)
Console.WriteLine(oCt.Subject)
Console.WriteLine(oCt.JobTitle)
oCt = oItems.GetNext
Loop
Console.WriteLine(iCount)
' Clean up.
oApp = Nothing
oItems = Nothing
oCt = Nothing
End Sub
S
Sue Mosher [MVP-Outlook]
The Namespace object always is your starting point for walking the folder hierarchy. It has a Folders collection that represents all the individual information stores, e.g. your mailbox and the Public Folders hierarchy. Each folder in the hierarchy, in turn, has its own Folders collection. Since folder names are unique in any Folders collection, you can use the name to get each level of the hierarchy. It may also be approprieate to use GetDefaultFolder and its enumeration. So, if you have a folder named Contacts that is a top-level folder in Public Folders\All Public Folders, this should work (at least on an English-language client):
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim pf as Outlook.MAPIFolder = oNS.Folders("Public Folders").Folders("All Public Folders")
Dim cContacts As Outlook.MAPIFolder = pf.Folders("Contacts")
But this should also work:
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim pf as Outlook.MAPIFolder = oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olPublicFoldersAllPublicFolders)
Dim cContacts As Outlook.MAPIFolder = pf.Folders("Contacts")
Instead of a console app, you might want to build a Windows application and use a form to show the results in a text box. Or use a MessageBox.Show statement.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim pf as Outlook.MAPIFolder = oNS.Folders("Public Folders").Folders("All Public Folders")
Dim cContacts As Outlook.MAPIFolder = pf.Folders("Contacts")
But this should also work:
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim pf as Outlook.MAPIFolder = oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olPublicFoldersAllPublicFolders)
Dim cContacts As Outlook.MAPIFolder = pf.Folders("Contacts")
Instead of a console app, you might want to build a Windows application and use a form to show the results in a text box. Or use a MessageBox.Show statement.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
C
chaser12
I have done this so far, but it is giving me this error An unhandled
exception of type 'System.NullReferenceException' occurred in
microsoft.visualbasic.dll
Additional information: Object variable or With block variable not set.
it is also not liking ISNull part, it says not declared.
Dim rst
Dim dao
Dim wks
Dim db
Dim nms
Dim fld
Dim itms
Dim itm
Dim strAccessDir
Dim objAccess
Dim strFolder
Dim fFound
Dim oApp As Outlook.Application = New Outlook.Application
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim pf As Outlook.MAPIFolder = oNS.Folders("Public
Folders").Folders("All Public Folders")
Dim cContacts As Outlook.MAPIFolder = pf.Folders("Contacts")
Dim itt As Outlook.ContactItem
Dim strdbname
'Pick up path to Access database directory from Access SysCmd function
objAccess = itt.oapp.CreateObject("Access.Application")
strAccessDir = objAccess.SysCmd(9)
strdbname = strAccessDir & "Contacts.mdb"
objAccess.Quit()
'Set up reference to Access database
dao = oApp.CreateObject("DAO.DBEngine.35")
wks = dao.Workspaces(0)
db = wks.OpenDatabase(strdbname)
'Open Access table containing data to import into Outlook
rst = db.OpenRecordset("tblCustomers")
Dim RecCount = rst.RecordCount
If RecCount = 0 Then
MsgBox("No customers to import")
Exit Sub
Else
MsgBox(RecCount, " customers to import")
End If
'Set up the Outlook folder and items and iterate
'through the Access table, adding one contact item using
'the custom form for each Access record
oNS = oApp.GetNamespace("MAPI")
pf = oNS.Folders("Public Folders").Folders("All Public Folders")
itm = pf.itt
Do Until rst.EOF
itm = itms.Add("IPM.Contact.Access Contact")
'Built-in Outlook properties
If IsNull(rst.CustomerID) = False Then itm.CustomerID =
rst.CustomerID
If IsNull(rst.CompanyName) = False Then itm.CompanyName =
rst.CompanyName
If IsNull(rst.ContactName) = False Then itm.FullName =
rst.ContactName
If IsNull(rst.Address) = False Then itm.BusinessAddressStreet =
rst.Address
If IsNull(rst.City) = False Then itm.BusinessAddressCity =
rst.City
If IsNull(rst.Region) = False Then itm.BusinessAddressState =
rst.Region
If IsNull(rst.PostalCode) = False Then
itm.BusinessAddressPostalCode = rst.PostalCode
If IsNull(rst.Country) = False Then itm.BusinessAddressCountry =
rst.Country
If IsNull(rst.Phone) = False Then itm.BusinessTelephoneNumber =
rst.Phone
If IsNull(rst.Fax) = False Then itm.BusinessFaxNumber = rst.Fax
If IsNull(rst.ContactTitle) = False Then itm.JobTitle =
rst.ContactTitle
'Custom Outlook properties
itm.UserProperties("Preferred") = rst.Preferred
itm.UserProperties("Discount") = rst.Discount
itm.Close(0)
rst.MoveNext()
Loop
rst.Close()
MsgBox("All contacts imported!")
End Sub
exception of type 'System.NullReferenceException' occurred in
microsoft.visualbasic.dll
Additional information: Object variable or With block variable not set.
it is also not liking ISNull part, it says not declared.
Dim rst
Dim dao
Dim wks
Dim db
Dim nms
Dim fld
Dim itms
Dim itm
Dim strAccessDir
Dim objAccess
Dim strFolder
Dim fFound
Dim oApp As Outlook.Application = New Outlook.Application
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim pf As Outlook.MAPIFolder = oNS.Folders("Public
Folders").Folders("All Public Folders")
Dim cContacts As Outlook.MAPIFolder = pf.Folders("Contacts")
Dim itt As Outlook.ContactItem
Dim strdbname
'Pick up path to Access database directory from Access SysCmd function
objAccess = itt.oapp.CreateObject("Access.Application")
strAccessDir = objAccess.SysCmd(9)
strdbname = strAccessDir & "Contacts.mdb"
objAccess.Quit()
'Set up reference to Access database
dao = oApp.CreateObject("DAO.DBEngine.35")
wks = dao.Workspaces(0)
db = wks.OpenDatabase(strdbname)
'Open Access table containing data to import into Outlook
rst = db.OpenRecordset("tblCustomers")
Dim RecCount = rst.RecordCount
If RecCount = 0 Then
MsgBox("No customers to import")
Exit Sub
Else
MsgBox(RecCount, " customers to import")
End If
'Set up the Outlook folder and items and iterate
'through the Access table, adding one contact item using
'the custom form for each Access record
oNS = oApp.GetNamespace("MAPI")
pf = oNS.Folders("Public Folders").Folders("All Public Folders")
itm = pf.itt
Do Until rst.EOF
itm = itms.Add("IPM.Contact.Access Contact")
'Built-in Outlook properties
If IsNull(rst.CustomerID) = False Then itm.CustomerID =
rst.CustomerID
If IsNull(rst.CompanyName) = False Then itm.CompanyName =
rst.CompanyName
If IsNull(rst.ContactName) = False Then itm.FullName =
rst.ContactName
If IsNull(rst.Address) = False Then itm.BusinessAddressStreet =
rst.Address
If IsNull(rst.City) = False Then itm.BusinessAddressCity =
rst.City
If IsNull(rst.Region) = False Then itm.BusinessAddressState =
rst.Region
If IsNull(rst.PostalCode) = False Then
itm.BusinessAddressPostalCode = rst.PostalCode
If IsNull(rst.Country) = False Then itm.BusinessAddressCountry =
rst.Country
If IsNull(rst.Phone) = False Then itm.BusinessTelephoneNumber =
rst.Phone
If IsNull(rst.Fax) = False Then itm.BusinessFaxNumber = rst.Fax
If IsNull(rst.ContactTitle) = False Then itm.JobTitle =
rst.ContactTitle
'Custom Outlook properties
itm.UserProperties("Preferred") = rst.Preferred
itm.UserProperties("Discount") = rst.Discount
itm.Close(0)
rst.MoveNext()
Loop
rst.Close()
MsgBox("All contacts imported!")
End Sub
S
Sue Mosher [MVP-Outlook]
This statement is invalid because the MAPIFolder object has no property named "itt"?
itm = pf.itt
This statement is invalid because you did not instantiate your itms object:
itm = itms.Add("IPM.Contact.Access Contact")
I suspect that what you wanted was this:
itm = pf.itms
If you have other statements raising errors, tell us what they are. Guessing is not much fun.
The article at http://www.ondotnet.com/pub/a/dotnet/excerpt/vbnetnut_appa/?page=4 explains why you can't use IsNull and what to use in its place.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
itm = pf.itt
This statement is invalid because you did not instantiate your itms object:
itm = itms.Add("IPM.Contact.Access Contact")
I suspect that what you wanted was this:
itm = pf.itms
If you have other statements raising errors, tell us what they are. Guessing is not much fun.
The article at http://www.ondotnet.com/pub/a/dotnet/excerpt/vbnetnut_appa/?page=4 explains why you can't use IsNull and what to use in its place.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
C
chaser12
An unhandled exception of type 'System.Runtime.InteropServices.COMException'
occurred in WindowsApplication15.exe
Additional information: Exception from HRESULT: 0x9CC401F3.
and it occurs here dao = oApp.CreateObject("DAO.DBEngine.35")
here the whole code.
Dim rst
Dim dao
Dim wks
Dim db
Dim nms
Dim fld
Dim itms
Dim itm
Dim strAccessDir
Dim objAccess
Dim strFolder
Dim fFound
Dim oApp As Outlook.Application = New Outlook.Application
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim pf As Outlook.MAPIFolder = oNS.Folders("Public
Folders").Folders("All Public Folders")
Dim cContacts As Outlook.MAPIFolder = pf.Folders("Contacts")
Dim itt As Outlook.ContactItem
Dim strdbname
objAccess = oApp.CreateObject("Access.Application")
strAccessDir = objAccess.SysCmd(9)
strdbname = strAccessDir & "Contacts.mdb"
objAccess.Quit()
'Set up reference to Access database
dao = oApp.CreateObject("DAO.DBEngine.35")
wks = dao.Workspaces(0)
db = wks.OpenDatabase(strdbname)
'Open Access table containing data to import into Outlook
rst = db.OpenRecordset("tblCustomers")
Dim RecCount = rst.RecordCount
If RecCount = 0 Then
MsgBox("No customers to import")
Exit Sub
Else
MsgBox(RecCount, " customers to import")
End If
'Set up the Outlook folder and items and iterate
'through the Access table, adding one contact item using
'the custom form for each Access record
oNS = oApp.GetNamespace("MAPI")
pf = oNS.Folders("Public Folders").Folders("All Public Folders")
itm = pf.itms
Do Until rst.EOF
itm = itms.Add("IPM.Contact.Access Contact")
'Built-in Outlook properties
If IsDBNull(rst.CustomerID) = False Then itm.CustomerID =
rst.CustomerID
If IsDBNull(rst.CompanyName) = False Then itm.CompanyName =
rst.CompanyName
If IsDBNull(rst.ContactName) = False Then itm.FullName =
rst.ContactName
If IsDBNull(rst.Address) = False Then itm.BusinessAddressStreet
= rst.Address
If IsDBNull(rst.City) = False Then itm.BusinessAddressCity =
rst.City
If IsDBNull(rst.Region) = False Then itm.BusinessAddressState =
rst.Region
If IsDBNull(rst.PostalCode) = False Then
itm.BusinessAddressPostalCode = rst.PostalCode
If IsDBNull(rst.Country) = False Then itm.BusinessAddressCountry
= rst.Country
If IsDBNull(rst.Phone) = False Then itm.BusinessTelephoneNumber
= rst.Phone
If IsDBNull(rst.Fax) = False Then itm.BusinessFaxNumber = rst.Fax
If IsDBNull(rst.ContactTitle) = False Then itm.JobTitle =
rst.ContactTitle
'Custom Outlook properties
itm.UserProperties("Preferred") = rst.Preferred
itm.UserProperties("Discount") = rst.Discount
itm.Close(0)
rst.MoveNext()
Loop
rst.Close()
MsgBox("All contacts imported!")
End Sub
occurred in WindowsApplication15.exe
Additional information: Exception from HRESULT: 0x9CC401F3.
and it occurs here dao = oApp.CreateObject("DAO.DBEngine.35")
here the whole code.
Dim rst
Dim dao
Dim wks
Dim db
Dim nms
Dim fld
Dim itms
Dim itm
Dim strAccessDir
Dim objAccess
Dim strFolder
Dim fFound
Dim oApp As Outlook.Application = New Outlook.Application
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("MAPI")
Dim pf As Outlook.MAPIFolder = oNS.Folders("Public
Folders").Folders("All Public Folders")
Dim cContacts As Outlook.MAPIFolder = pf.Folders("Contacts")
Dim itt As Outlook.ContactItem
Dim strdbname
objAccess = oApp.CreateObject("Access.Application")
strAccessDir = objAccess.SysCmd(9)
strdbname = strAccessDir & "Contacts.mdb"
objAccess.Quit()
'Set up reference to Access database
dao = oApp.CreateObject("DAO.DBEngine.35")
wks = dao.Workspaces(0)
db = wks.OpenDatabase(strdbname)
'Open Access table containing data to import into Outlook
rst = db.OpenRecordset("tblCustomers")
Dim RecCount = rst.RecordCount
If RecCount = 0 Then
MsgBox("No customers to import")
Exit Sub
Else
MsgBox(RecCount, " customers to import")
End If
'Set up the Outlook folder and items and iterate
'through the Access table, adding one contact item using
'the custom form for each Access record
oNS = oApp.GetNamespace("MAPI")
pf = oNS.Folders("Public Folders").Folders("All Public Folders")
itm = pf.itms
Do Until rst.EOF
itm = itms.Add("IPM.Contact.Access Contact")
'Built-in Outlook properties
If IsDBNull(rst.CustomerID) = False Then itm.CustomerID =
rst.CustomerID
If IsDBNull(rst.CompanyName) = False Then itm.CompanyName =
rst.CompanyName
If IsDBNull(rst.ContactName) = False Then itm.FullName =
rst.ContactName
If IsDBNull(rst.Address) = False Then itm.BusinessAddressStreet
= rst.Address
If IsDBNull(rst.City) = False Then itm.BusinessAddressCity =
rst.City
If IsDBNull(rst.Region) = False Then itm.BusinessAddressState =
rst.Region
If IsDBNull(rst.PostalCode) = False Then
itm.BusinessAddressPostalCode = rst.PostalCode
If IsDBNull(rst.Country) = False Then itm.BusinessAddressCountry
= rst.Country
If IsDBNull(rst.Phone) = False Then itm.BusinessTelephoneNumber
= rst.Phone
If IsDBNull(rst.Fax) = False Then itm.BusinessFaxNumber = rst.Fax
If IsDBNull(rst.ContactTitle) = False Then itm.JobTitle =
rst.ContactTitle
'Custom Outlook properties
itm.UserProperties("Preferred") = rst.Preferred
itm.UserProperties("Discount") = rst.Discount
itm.Close(0)
rst.MoveNext()
Loop
rst.Close()
MsgBox("All contacts imported!")
End Sub
S
Sue Mosher [MVP-Outlook]
I don't know how .NET-friendly DAO is. You'd be better off asking about that on a .NET forum. Better yet, ditch DAO and use ADO.NET methods instead.
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
--
Sue Mosher, Outlook MVP
Author of
Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
Ask a Question
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.