Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Import Outlook Data into Access 2007 using VBS

Posted on 2009-04-01
18
Medium Priority
?
810 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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
 

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 2000 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

Veeam Task Manager for Hyper-V

Task Manager for Hyper-V provides critical information that allows you to monitor Hyper-V performance by displaying real-time views of CPU and memory at the individual VM-level, so you can quickly identify which VMs are using host resources.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
If you’re using QODBC to update QuickBooks data from Microsoft® Access but Access is not showing the updated data, you could have set up QODBC incorrectly.
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.

824 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