MSProject -> Access -> Snapshot File => HELP!

I have a MS Project 98 file that I will be exporting to an access database.  In this database, I am generating a report.  From this report, I am saving it as a Snapshot file and then linking to it from a webpage (using the Snapshot viewer, but that's not my question...).  Okay, so i want to program all of this to happen at once.  I don't knwo if i should be writing a Project macro, or an Access macro, or a complete stand-alone VB app that will do it all...  Here are the steps that i want (some sort of code) to accomplish:

1. Save As...
2. change save as type to Access (.mbd)
3. enter filename "database"
4. click save
5. when prompted to Append or Overwrite already     existing database, choose Append
6. select map named "QuantReport"
7. click OK
8. when prompted that you are about to overwrite a table in the database, choose OK

9. Save As...
10. choose: ...To an external file/database, then OK
11. change save as type to Snapshot File (.snp)
12. choose filename
13. click export
14. if prompted that you are about to overwrite, automatically choose OK.

Now...  i'm thinking that since i'm dealing with two different programs, i am going to need to create a little VB app that does all of this on its own.  that actually may be even better - this way i can create a little form that will allow the user to change things like the file names, etc...  but i DO NOT want this to get too complicated!!

Can anyone help me out in figuring out what approach to take, how to take it, and offer some code suggestions...  (i am not a VB Expert..!).  

Who is Participating?
TrygveConnect With a Mentor Commented:
1) When in you plan/MPP, press ALT+F11. This will take you to the Visual Basic Editor
2) Look at the tree on the upper left side of the window. Make sure that VBAProject(Your File Name) is the branch you are on
3) Goto Modules under this branch, right click and insert, select module.
4) When in the module you just created Copy/Paste the code at the bottom of this posting into the module.

Now close the Visual Basic Editor and go back to your MPP file.

5) Right click on the grey area next to one of your toolbars and select Customize
6) Select New and name the toolbar "MyToolbar" or a name you like better
7)You now have a small toolbar. Select the Commands tab and drag any Icon onto the toolbar you just created.
8) Right-click the icon and select Assign Macro. Command=Export, Name=Export to Access and create snapshot file
9) Change the icon to a nice looking one.

Now the button should do what you want. I was not able to avoid the two questions about overwriting and Appending. I don't know if this is possible since the questions come from the export filter and not from Project itself. But if you instruct your users this should not be a very big problem.

Hope you can use it. Please let me know if you need more details on putting it together.


   Option Explicit

   Declare Function SetForegroundWindow Lib "User32" _
     (ByVal hWnd As Long) As Long
   Declare Function IsIconic Lib "User32" _
     (ByVal hWnd As Long) As Long
   Declare Function ShowWindow Lib "User32" _
     (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
   Const SW_NORMAL = 1     'Show window in normal size
   Const SW_MINIMIZE = 2   'Show window minimized
   Const SW_MAXIMIZE = 3   'Show window maximized
   Const SW_SHOW = 9       'Show window without changing window size

   Dim objAccess As Object 'module-level declaration

   'This procedure brings the instance of Microsoft Access referred to
   'as "instance" into view. The instance's window size can be SW_NORMAL,
   'SW_MINIMIZE, SW_MAXIMIZE, or SW_SHOW. If size is omitted, the window is
   'not changed (SW_SHOW). To call this function, use this syntax:
   '   ShowAccess instance:=objAccess, size:=SW_SHOW

   Sub ShowAccess(instance As Object, Optional size As Variant)
     Dim hWnd As Long, temp As Long

     If IsMissing(size) Then size = SW_SHOW
     On Error Resume Next
         If Not instance.UserControl Then instance.Visible = True
         On Error GoTo 0 'turn off error handler
         hWnd = instance.hWndAccessApp
         temp = SetForegroundWindow(hWnd)
         If size = SW_SHOW Then 'keep current window size
              If IsIconic(hWnd) Then temp = ShowWindow(hWnd, SW_SHOW)
              If IsIconic(hWnd) And size = SW_MAXIMIZE Then _
                temp = ShowWindow(hWnd, SW_NORMAL)
              temp = ShowWindow(hWnd, size)
         End If
   End Sub

Sub Export()
    Const DatabaseName = "snapshot.mdb"
    Const path = "C:\Misc\DATA\ACCESS\EXPERTS\econy1\MSProject - Access - Snapshot File - HELP\"
    Const ReportToExport = "Resource_Export_Table"
    Const SnapshotFileName = "ResourceExportTable.snp"
    Const MapName = "Resource ""Export Table"" map" ' Mine is named:   Resource "Export Table" map
     ' Constants from Access. Defined here to make the code equal without hardcoded numeric values.
     Const acPreview = 2
     Const acExport = 1
     Const acOutputReport = 3
    ' Export data to table
    FileSaveAs Name:="<" & path & DatabaseName & ">", FormatID:="MSProject.MDB8.8", map:=MapName

     On Error Resume Next  'temporary error handling to check for open Access
     Set objAccess = GetObject(, "Access.Application")

       If Err <> 0 Then 'no existing instances of Access
         Set objAccess = CreateObject("Access.Application")
       End If

       On Error GoTo OpenSnapshot_ErrHandler 'normal error handler
       ShowAccess instance:=objAccess, size:=SW_MAXIMIZE

       With objAccess
         ' Make sure that the correct database is open
         If .DBEngine.Workspaces(0).Databases.Count = 0 Then
            .OpenCurrentDatabase filepath:=path & DatabaseName
         ElseIf LCase(Right(.CurrentDb.Name, Len(DatabaseName))) _
             <> DatabaseName Then

            .OpenCurrentDatabase filepath:=path & DatabaseName
         End If
         ' Output to snapshot format
         .DoCmd.OutputTo acOutputReport, ReportToExport, "Snapshot Format (*.snp)", _
            path & SnapshotFileName
        ' Close database
        ' Close Access

       End With
     Exit Sub

     MsgBox Error$(), , "Open Snapshot"
   End Sub
econy1Author Commented:
Ok, i need help QUICK!!
I've increased to 300 points...  maybe this will help...!
You should be able to do this from Project. The VBA module can do a lot, and getting Access to save to a SNP file from Project should be possible too.

If you want you can EMail me the files and I will try to put it together for you, no strings made on this thread. It is much easier to do testing when you have access to the "real thing". If you want don't want this, I can try to put something together here. ( I will post any findings I do here as I go along.
Get 10% Off Your First Squarespace Website

Ready to showcase your work, publish content or promote your business online? With Squarespace’s award-winning templates and 24/7 customer service, getting started is simple. Head to and use offer code ‘EXPERTS’ to get 10% off your first purchase.

econy1Author Commented:
thank you, Trygve...  unfortunately, i can not send any files - they are confidential.   really, though, what is in the files is irrelevent to the goals i have for the vba.  

any other suggestions?  
No problem, I will create a test case and get back to you :-)
You will need to reference Access you plan.  "Microsoft Access 8.0 Object Library"

Tools, references and select from the list.
econy1Author Commented:
i'm sorry, i have no idea what you're talking about.  i am not a very experienced VB/VBA programmer...  although i have done some...   please clarify/explain - THANKS!
econy1Author Commented:
i'm sorry, i have no idea what you're talking about.  i am not a very experienced VB/VBA programmer...  although i have done some...   please clarify/explain - THANKS!
My guess is that last comment (copy of the previous) was caused by the famous "E-E Refresh button ghost" ?
econy1Author Commented:
thank you very much for providing a WORKING answer!!
now...  just that one other thing - if there is ANY way that you can suggest to answer those two dialog boxes (Append; OK to overwriting the table) - I will be beside myself with joy!  =)

i'll leave this open for just a while longer, and then reward you the points...  thanks again, and let me know soon if you have any ideas on having those questions answered in the code...

econy1Author Commented:
One more question, as well...

I am using your code.  I would like to create a form that would enable the user to choose what the destination filename of the access database will be and what the destination filename of the snapshot file will be.  of course, these will probably stay the same most of the time - but in case they change, i don't want the user to have to go into the code to change them.

any ideas?  i can't get the comdlg32.dll thing to work.  how do i program the Open File dialog to come up so that a filename can be selected, and then placed in a text box....?


PS - Trygve, you'll get your points, i promise!!
I think we will be stuck with the two boxes asking for Append/Overwrite. I will look further into it though, but my hopes are low for this one.

As for the two names you could use InputBox to get the name from your user, but using File Dialog is more elegant, I agree. ComDlg32.dll is a bit scary since it has changed version many times and it tends to screw up if the application that made a project does not have the same version as the current machine. This might not be valid for Project though. I will look into this later today or on monday. I have held a demonstration today and I might not get back to my normal machine before the day is over.

I'll get back to you.
Put this in the top of you module;

'**                               Common Dialog Win32 API Spesific Declaration                                **

Private Const MAX_PATH = 260

  nStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As Long
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As Long
  nMaxFile As Long
  lpstrFileTitle As Long
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_PATHMUSTEXIST = &H800

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long

Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40

'**                           End Common Dialog Win32 API Spesific Declaration                                **

Then put this somewhere in the module;

Function afGetOpenFileName(szDefExt As String, pFileMaskBuff() As String, Optional szInitialDir As String) As String
' Code for opening end getting openfilename from Common Dialogs API
' Parameters.:  pFileMaskBuff= Array of string that describe the filemask. Each string must
'                              have the following format...
'                              "Document Files (*.doc)|*.doc"
'                              If you dont follow this roules, the procedure wil fail or
'                              dont work properly.
'               szDefExt     = Filename extension for document if user is
'                              not specified one. This extension is added
'                              to the returning filename.
'               szInitialDir = Optional. The pathname for where Open Dialogbox
'                              should start from. If omited, the Open Dialog
'                              display what windows sets.
' Returns....:  If user selects Ok button in Open FileName dialogbox,
'               the drive+full path+ filename is returned. If user
'               select Cancel, vbNullString is returned.
' Last update: 20.Apr.1999 Trygve
' WARNING!!! : Anyone that is not familiar with Win32 CommonDialog , Win32 Memory
'              management and how VB interact with Win32, should not tempt to
'              alter anyting of following code.
  Dim OPFN As OPENFILENAME, hglb As Long, lpBuffer As Long, szBuffer As String, nDummy As Long
  Dim szFilterBuffer As String, hglbFilter As Long
  Dim nFileMaskCount As Integer, nStartPos As Integer, nEndPos As Integer
  Dim szTempA As String, szTempB As String
  Const nGlbFlag As Long = GMEM_FIXED Or GMEM_ZEROINIT
  szFilterBuffer = vbNullString
  For nFileMaskCount = 0 To UBound(pFileMaskBuff)
    nStartPos = InStr(1, pFileMaskBuff(nFileMaskCount), "|")
    szTempA = Mid$(pFileMaskBuff(nFileMaskCount), 1, nStartPos - 1)
    szTempB = Mid$(pFileMaskBuff(nFileMaskCount), nStartPos + 1, Len(pFileMaskBuff(nFileMaskCount)) - nStartPos)
    szFilterBuffer = szFilterBuffer & szTempA & Chr$(0) & szTempB & Chr$(0)
  szFilterBuffer = szFilterBuffer & Chr$(0)
  hglbFilter = GlobalAlloc(nGlbFlag, Len(szFilterBuffer))
  If hglbFilter = 0 Then
    afGetOpenFileName = vbNullString
    Exit Function
  End If
  hglb = GlobalAlloc(nGlbFlag, MAX_PATH)
  If hglb = 0 Then
    nDummy = GlobalFree(hglbFilter)
    afGetOpenFileName = vbNullString
    Exit Function
  End If
  OPFN.nStructSize = Len(OPFN)
  'OPFN.hwndOwner = hwndOwner
  OPFN.hInstance = 0
  OPFN.lpstrFilter = GlobalLock(hglbFilter)
  CopyMemory ByVal OPFN.lpstrFilter, ByVal szFilterBuffer, Len(szFilterBuffer)
  OPFN.nFilterIndex = 1
  OPFN.lpstrFile = GlobalLock(hglb)
  OPFN.nMaxFile = MAX_PATH
  If IsMissing(szInitialDir) Then
    OPFN.lpstrInitialDir = vbNullString
    OPFN.lpstrInitialDir = szInitialDir
  End If
  OPFN.lpstrFileTitle = 0
  OPFN.nMaxFileTitle = 0
  OPFN.lpstrDefExt = szDefExt
  OPFN.lpfnHook = 0
  OPFN.lpTemplateName = vbNullString
  nDummy = GetOpenFileName(OPFN)
  If nDummy = 0 Then
    szBuffer = vbNullString
    szBuffer = Space$(MAX_PATH)
    CopyMemory ByVal szBuffer, ByVal OPFN.lpstrFile, MAX_PATH
  End If
  '** Unlock and free filename buffer.
  nDummy = GlobalUnlock(hglb)
  nDummy = GlobalFree(hglb)

  '** Unlock and free filter buffer.
  nDummy = GlobalUnlock(hglbFilter)
  nDummy = GlobalFree(hglbFilter)
  afGetOpenFileName = RTrim$(szBuffer)
End Function

Finaly this will give you a filename. It will have to be adjusted to fit your needs;

    Dim szSource As String
    Dim pFileMaskBuff(5) As String, szCurrentPath As String
    szCurrentPath = ""
    pFileMaskBuff(0) = "All Files (*.*)|*.*"
    pFileMaskBuff(1) = "Pdf Files (*.pdf)|*.pdf"
    pFileMaskBuff(2) = "Word Documents (*.doc)|*.doc"
    pFileMaskBuff(3) = "Excel WorkSheet (*.xls)|*.xls"
    pFileMaskBuff(4) = "PowerPoint (*.ppt)|*.ppt"
    pFileMaskBuff(5) = "Text Documents (*.txt)|*.txt"
    szSource = afGetOpenFileName(vbNullString, pFileMaskBuff, szCurrentPath)

It seems to work perfectly in my test project file.

econy1Author Commented:
Thank you for your help - it's all working great...

Well, ALMOST great... I still want to find out if there's a way to programmatically respond to the 3 prompts i still get regarding
     1) Appending the Access database
     2) Overwriting the table in the Access Database
     3) Overwriting the Snapshot file (since it already exists)

Thanks again for your help.  I am going to post another question to try and find out how to polish this project off!

Kill path & SnapshotFileName  should remove the snapshot file. Put it right before the line the produces the new one.

Perhaps this will work even better.

' Check if snapshot file already exist
If not nz(Dir(path & SnapshotFileName) ,"")="" then
  ' If so, remove it
  Kill path & SnapshotFileName
end if
One possible way of getting rid of the two remaining problems could be this.

1) Have another database contain the records which the report is based on.
2) Delete the "saved" database using the code above before each export.
3) After the export let some queries append the new records from the saved database into the storage database. This should not be to hard to do
4) Then proceed with the rest of the code.

This adds some code to your project, but should be possible to achieve. Let me know if you need help on putting it together (testing). I will try a bit and let you know what I find.
Project does not like the nz function.

' Check if snapshot file already exist
If not Dir(path & SnapshotFileName)="" then
  ' If so, remove it
  Kill path & SnapshotFileName
end if
I got it !!!!!!!!!!

To save to the database without getting the confirming boxes. You should check that this still does what you want, but it seems very promissing.
Let me know...

    ' Export data to table
    Application.Alerts False
    FileSaveAs Name:="<" & path & DatabaseName & ">", FormatID:="MSProject.MDB8.8", map:=MapName
    Application.Alerts True

econy1Author Commented:
Wonderful...  I thought of this yesterday, and implemented it this morning and it's working great!  In fact, it is Application.ShowAlerts = [True/False]

One little question.  I now am using a form simply to display the status of the operation (kind of like a little timer)...  Once all files are saved (the last one is the snapshot file from Access), a "Done" button should be enabled and that will close the little form and end the macro.  I am calling the form from within the main function like this:

    'Initialize status form
    Load frmExport_Status

the problem is that once the form is called, the program stops executing the rest of the code!!!  i haven't played around for too long yet - but if you've got a quick solution, that'd help me out a LOT!!

Application.Alerts [True/False] works. I tried it. Perhaps they are similar commands?

Perhaps you could use the status bar for the execution information instead and open the form with the done button when the code is done? Then it wont matter that it stops.

I haven't got any experience with forms in Project so I can't help you without testing.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.