' Uncomment (Remove the ' ) the two lines of code below if they are not already at the top of your Module
'Option Compare Database
'Option Explicit
 
'---------------------------------------------------------------------------------------
' Procedure : SaveSNP
' DateTime  : 1/26/2008 00:36
' Author    : Patrick Wood
' Purpose   : Saves all Reports Open in Preview as Snapshot Files.
'           : Can be called by a Report Shortcut Menu Command
'---------------------------------------------------------------------------------------
' Notes: The File Path must exist for the Snapshot to be saved.
' If the file already exists, it will be written over by the new file
 
 
Public Function SaveSNP()
On Error GoTo Err_SaveSNP
 
    Dim obj As AccessObject
    Dim dbs As Object
    Dim strRptName As String
    Dim strSnpName As String
    Dim strSnpshot As String
    Dim strPath As String
 
    ' Set a Reference to Microsoft Office Object Library
    AddReferenceMSODLL
 
    ' Set the File Path using the Windows Dialog Window
    strPath = GetFolderPath
 
    'Make sure the Path ends with a \
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
 
    Debug.Print "strPath = " & strPath
 
    Set dbs = Application.CurrentProject
 
    ' Search for an open Report
    For Each obj In dbs.AllReports
        If obj.IsLoaded = True Then
            strRptName = obj.Name
            'Let the user choose the name of the Snapshot.
            Select Case MsgBox("Click ""Yes"" to use the Report name.           " _
                & vbCrLf & "" _
                & vbCrLf & "Click ""No"" to enter a different name." _
                , vbYesNo Or vbQuestion Or vbDefaultButton1, _
                "                   Use Report Name?")
 
                Case vbYes
                    strSnpName = strRptName
 
                Case vbNo
                    'Open the Input Box and instruct the user
                    strSnpshot = InputBox("           " & _
                    "    Please enter a name for your Snapshot.       ")
 
                    'Check if a name has been entered
                    If Len(strSnpshot & "") > 0 Then
                        strSnpName = strSnpshot
                    Else
                       ' Use the Report Name
                        strSnpName = strRptName
                    End If
            End Select
 
            If Right(strSnpName, 4) <> ".snp" Then
                strSnpName = strSnpName & ".snp"
            Else
                ' The name is OK so just use it
            End If
            Debug.Print "strSnpName = " & strSnpName
 
            ' Save the Report as a Snapshot
            DoCmd.OutputTo ObjectType:=acOutputReport, ObjectName:=strRptName, _
            OutputFormat:=acFormatSNP, OutputFile:=strPath & strSnpName
        '    AutoStart:=True  ' Uncomment this code to automatically
        End If                ' open the Snapshot file
    Next obj
 
    ' Clean up
    Set obj = Nothing
    Set dbs = Nothing
 
Exit_SaveSNP:
    Exit Function
 
Err_SaveSNP:
    Call MsgBox(Err.Description & vbCrLf & "Error Number: " & Err.Number & vbCrLf & _
    " In procedure SaveSNP of Module basRptSnapshot")
    Resume Exit_SaveSNP
 
End Function