asked on

Import Outlook Data into Access 2007 using VBS

Hello,

i've got a very specific problem to solve.
I'm not interested in "other" ways to solve it, just plain VBA Code which fully or partially helps me solve the Problem.

Problem:
I want to have a subroutine which Imports Data from Outlook ( a calendar ) into an access Table.
Using the Access 2007 GUI i would just do the following:
"External Data" -> "Import" -> "Outlook Folder" -> Select my Outlook Calendar -> "Finish"
It's very easy because the Name of my destination Table and the source Calendar are just the same.

I've already ceated a form with some functions and an "Import" Button with the code below.
What is currently missing ( and that part should come from you ! ) is the final call, which tells Access to import the Data.
Just take a look at the code below.
Hint: the Code below is working fine, "just" the Import part is missing.

Helpfull links are:
http://support.microsoft.com/kb/290658/en-us
http://www.amazon.com/gp/blog/post/PLNKZECPY1GBYF87

with best regards,

FA

Private Sub Befehl32_Click()
 
    Dim ns As Outlook.NameSpace
    Set ns = GetNamespace("MAPI")
 
    Dim Folder As Outlook.MAPIFolder
    Set Folder = ns.PickFolder
 
    Set oDataBase = CurrentDb
    Set rst = oDataBase.OpenRecordset("Kalender")
 
   ' DoImportDataFromOutlookToAccess(Folder,rst)
 
End Sub

Open in new window

TextReport

The code to go into Line 13 is below
Cheers, Andrew

Dim rstNew as Recordset
Dim cnt As Long
 
    Set rstNew = oDataBase.OpenRecordSet("MyTable")
 
    Do While Not oDataBase.EOF
       rstNew.AddNew
'If All the fields match you can use the next 3 lines.
           For cnt = 0 To oDataBase.Fields.Count -1
               rstNew(cnt) = oDataBase(cnt)
           Next cnt
' Otherwise you can use this syntax
         rstNew!Field1Name = oDataBase!Field1Name
         rstNew!Field2Name = oDataBase!Field2Name
 
       rstNew.Update
       oDataBase.MoveNext
    Loop
 
    rstNew.Close
    Set rstNew = Nothing
    oDataBase.Close
    Set oDataBase = Nothing

Open in new window

firearmz

ASKER

Hello,

the code looks great, but i get a Runtime Error 438:
Object doenst support this Method.

I think some library is missing, i'll try to look it up.
If you have any idea please reply!

regards,
FA

TextReport

Check the Microsoft DAO Library, probably v3.6 and change my line 1 to

Dim rstNew as DAO.Recordset

Cheers, Andrew

firearmz

ASKER

Sorry no success.
I included DAO 3.6 ( had to remove the generall office 12 object lib first ).
Changed the line as mentioned.
Current code is below:

    Dim ns As Outlook.NameSpace
    Set ns = GetNamespace("MAPI")
 
    Dim Folder As Outlook.MAPIFolder
    Set Folder = ns.PickFolder
 
    Set oDataBase = CurrentDb
    'Set rst = oDataBase.OpenRecordset("Kalender")
        
    Dim rstNew As DAO.Recordset
    Dim cnt As Long
 
    Set rstNew = oDataBase.OpenRecordset("Kalender")
 
    Do While Not oDataBase.EOF <---!!!-- Line causing the error !
       rstNew.AddNew
 
           For cnt = 0 To oDataBase.Fields.Count - 1
               rstNew(cnt) = oDataBase(cnt)
           Next cnt
 
       rstNew.Update
       oDataBase.MoveNext
    Loop
 
    rstNew.Close
    Set rstNew = Nothing
    oDataBase.Close
    Set oDataBase = Nothing

Open in new window

TextReport

Is Kalander the name of the table from outlook?
Cheers, Andrew

firearmz

ASKER

No and Yes, "Kalender" is the Table in which the so called "Kalender" from Outlook should be Imported

TextReport

I take it you have the Kalender attached as a table at the moment? Is so then the code needs changing a bit. I was looking at oDataBase rather than rst.
Cheers, Andrew

    Dim ns As Outlook.NameSpace
    Set ns = GetNamespace("MAPI")
 
    Dim Folder As Outlook.MAPIFolder
    Set Folder = ns.PickFolder
 
    Set oDataBase = CurrentDb
    Set rst = oDataBase.OpenRecordset("Outlook_Kalender")
        
    Dim rstNew As DAO.Recordset
    Dim cnt As Long
 
    Set rstNew = oDataBase.OpenRecordset("Kalender")
 
    Do While Not rst.EOF
       rstNew.AddNew
 
           For cnt = 0 To rst.Fields.Count - 1
               rstNew(cnt) = rst(cnt)
           Next cnt
 
       rstNew.Update
       rst.MoveNext
    Loop
 
    rstNew.Close
    Set rstNew = Nothing
    rst.Close
    Set rst = Nothing

Open in new window

firearmz

ASKER

Runtime Error 3078
Microsoft Office Access Database Module couldnt find 'Outlook_Kalendar'...

TextReport

Outlook_Kalendar is a name I used to represent the already attached outlook calander that you said you can already link to, the code then uses the data from the attached table a appends to your local table.
Cheers, Andrew

firearmz

ASKER

Ok i changed the code as follows, looks good so far but i get the following error:
Runtime 3022
You change couldn't be applied because the Index, Primary Key or Relation could containt multiple values.
Change the Field values, or remove the index.

Any hint?
Should i flush the ( or how can i ) the target AccessTable using VBCode?

firearmz

ASKER

forgot the actual code.
Take a look.

    Dim ns As Outlook.NameSpace
    Set ns = GetNamespace("MAPI")
 
    Dim Folder As Outlook.MAPIFolder
    Set Folder = ns.PickFolder
 
    Set oDataBase = CurrentDb
    Set rst = oDataBase.OpenRecordset(Folder) <- is this correct, looks like it works?
        
    Dim rstNew As DAO.Recordset
    Dim cnt As Long
 
    Set rstNew = oDataBase.OpenRecordset("Kalender")
 
    Do While Not rst.EOF
       rstNew.AddNew
 
           For cnt = 0 To rst.Fields.Count - 1
               rstNew(cnt) = rst(cnt)
           Next cnt
 
       rstNew.Update
       rst.MoveNext
    Loop
 
    rstNew.Close
    Set rstNew = Nothing
    rst.Close
    Set rst = Nothing

Open in new window

TextReport

It looks like you are trying to add a record that already exisists.
Cheers, Andrew

firearmz

ASKER

I think the problem is getting the Data from outlook, currently i'm only getting the folder path.
Could you please help me with this.

ASKER CERTIFIED SOLUTION

TextReport

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

firearmz

ASKER

Thanks for the flexibility!
I've implemented your code but get the following Error:

An unexpected error has occured in ListAppointments
Error 3265 -> Element not found in Listing

Hint: i cleared the local Acces Table.
The Access Table called "Kalendar" is now empty.

TextReport

When the error message appears do a CTRL-BREAK then click on RETRY, then using F8 step through each line of code until you get back to the code where the error is. You will probably find that the error is caused by a field name being wrong in the area of

!Start = outAppointment.Start
!End = outAppointment.End
!Subject = outAppointment.Subject

Cheers, Andrew

firearmz

ASKER

TextReport, looks good so far. I'll contact you again if i encounter any problem.

firearmz

ASKER

Just two words,
epic win !

Thanks TextReport :-)