Solved

Import Outlook Data into Access 2007 using VBS

Posted on 2009-04-01
18
795 Views
Last Modified: 2012-06-27
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

0
Comment
Question by:firearmz
  • 10
  • 8
18 Comments
 
LVL 28

Expert Comment

by:TextReport
ID: 24047890
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

0
 

Author Comment

by:firearmz
ID: 24048322
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
0
 
LVL 28

Expert Comment

by:TextReport
ID: 24048330
Check the Microsoft DAO Library, probably v3.6 and change my line 1 to

Dim rstNew as DAO.Recordset

Cheers, Andrew
0
 

Author Comment

by:firearmz
ID: 24048375
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

0
 
LVL 28

Expert Comment

by:TextReport
ID: 24048405
Is Kalander the name of the table from outlook?
Cheers, Andrew
0
 

Author Comment

by:firearmz
ID: 24048410
No and Yes, "Kalender" is the Table in which the so called "Kalender" from Outlook should be Imported
0
 
LVL 28

Expert Comment

by:TextReport
ID: 24048437
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

0
 

Author Comment

by:firearmz
ID: 24048491
Runtime Error 3078
Microsoft Office Access Database Module couldnt find 'Outlook_Kalendar'...
0
 
LVL 28

Expert Comment

by:TextReport
ID: 24048505
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
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:firearmz
ID: 24048525
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?
0
 

Author Comment

by:firearmz
ID: 24048528
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

0
 
LVL 28

Expert Comment

by:TextReport
ID: 24048535
It looks like you are trying to add a record that already exisists.
Cheers, Andrew
0
 

Author Comment

by:firearmz
ID: 24048773
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.
0
 
LVL 28

Accepted Solution

by:
TextReport earned 500 total points
ID: 24049185
OK complete change of tack as I was under the impression you had the outlook side working. Below is a way to loop through all appointments and you will need to expand on the fields you wish to add to your table.
Cheers, Andrew
Function ListAppointments()

On Error GoTo ListAppointments_Err

Dim outobj As Outlook.Application

Dim outAppointment As Outlook.AppointmentItem

Dim outAppointments As Outlook.Items

Dim outNameSpace As Outlook.NameSpace

Dim outFolder As Outlook.Folder

Dim strCondition As String

Dim strMSG As String

Dim oDataBase as DAO.Database

Dim rstNew As DAO.Recordset
 

    Set outobj = CreateObject("outlook.application")

    Set outNameSpace = outobj.GetNamespace("MAPI")

'    Set outFolder = outNameSpace.GetDefaultFolder(olFolderCalendar)

    Set outFolder = outNameSpace.PickFolder

 

    Set oDataBase = CurrentDB

    Set rstNew = oDataBase.OpenRecordset("Kalender")
 

    For Each outAppointment In outFolder.Items

        Debug.Print outAppointment.Start, outAppointment.Subject

        With rstNew

           .AddNew

               !Start = outAppointment.Start

               !End = outAppointment.End

               !Subject = outAppointment.Subject

           .Update

       End With

    Next outAppointment

    rstNew.Close

    Set rst = Nothing
 

ListAppointments_Exit:

    ' Release the Outlook object variable.

    Set outobj = Nothing

    Exit Function
 

ListAppointments_Err:

    Select Case Err

        Case Else

             strMSG = "An unexpected error has oocurred in ListAppointments" & vbCrLf & vbCrLf & _

                      "Error " & vbTab & "Description" & vbCrLf & _

                      Err.Number & vbTab & Err.Description

             Select Case MsgBox(strMSG, vbCritical + vbAbortRetryIgnore, "Error in ListAppointments")

                 Case vbAbort:  Resume ListAppointments_Exit

                 Case vbIgnore: Resume Next

                 Case vbRetry:  Resume

             End Select

    End Select
 

End Function

Open in new window

0
 

Author Comment

by:firearmz
ID: 24049459
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.
0
 
LVL 28

Expert Comment

by:TextReport
ID: 24049503
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
0
 

Author Comment

by:firearmz
ID: 24050627
TextReport, looks good so far. I'll contact you again if i encounter any problem.
0
 

Author Closing Comment

by:firearmz
ID: 31565383
Just two words,
epic win !

Thanks TextReport :-)
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now