PRJ41: Using DAO to Export Data to Microsoft Access

MORE INFORMATION

Microsoft provides examples of Visual Basic procedures for illustration only, without warranty either expressed or implied, including but not limited to the implied warranties of merchantability and/or fitness for a particular purpose. This Visual Basic procedure is provided 'as is' and Microsoft does not guarantee that it can be used in all situations. Microsoft does not support modifications of this procedure to suit customer requirements for a particular purpose.

This macro prompts for a unique file name to be entered in the format, C:\PROJECT.MDB. If the file already exists an error will occur.

When the file is successfully created, the macro will go through all the tasks on the current project and save the ID, Task name, Start, Finish and Duration fields to the database file. The macro can easily be expanded to save any of the project fields that are needed.

In a new macro module, before entering the macro code, click References on the Tools menu, and then select the Microsoft DAO 3.0 Compatibility object library

Sample Macro Code

    Sub ProjectToAccess()

   Dim projdb As Variant
   Dim projtable As TableDef
   Dim projrecset As Recordset
   Dim task As Object
   Dim filename As String

   filename = InputBox("Please enter a full filename with a .MDB _
   extension" & Chr(13) & "E.g. - C:\PROJECT.MDB", "Inputbox")

   If filename = "" Then Exit Sub

   ' dbVersion20 specifies the Microsoft Jet database engine version.
   Set projdb = CreateDatabase(filename, dbLangGeneral, dbVersion20)
   Set projtable = projdb.CreateTableDef("Project")

   projtable.Fields.Append projtable.CreateField("ID", dbText)
   projtable.Fields.Append projtable.CreateField("Task Name", dbText)
   projtable.Fields.Append projtable.CreateField("Start", dbDate)
   projtable.Fields.Append projtable.CreateField("Finish", dbDate)
   projtable.Fields.Append projtable.CreateField("Duration", dbText)

   projdb.TableDefs.Append projtable

   Set projrecset = projdb.OpenRecordset("project")

   With projrecset
        For Each task In ActiveProject.Tasks
             If Not (task Is Nothing) Then
                  .AddNew
                  ![id] = task.id
                  ![Task Name] = task.Name
                  ![start] = task.start
                  ![finish] = task.finish
                  ![duration] = task.duration
                  .Update
             End If
        Next
   End With

   projdb.Close

   set projrecset = nothing
   set projtable = nothing
   set projdb = nothing

   MsgBox "Finished Creating Database - " & filename

   End Sub