Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win


Building a MSA database to read an input file, performs a calculation, creates a report & outputs a prn file from selected report data

Posted on 2016-10-05
Medium Priority
Last Modified: 2016-11-06
Our company wants to use a VBA module in Microsoft Access 2016 to do the following:
1) Read in an excel file with data that will be used to perform a calculation
2) Create a report that checks the calculated results for outliers that fall outside of a lower & upper set of boundaries for quality purposes (we would like to build this in as a modifiable setting that can be changed by the user but are willing to make these settings predefined within the VBA code)
3) Output a .prn file that contains the results of the calculation

My idea is to do the following:
1) Create a form within a database with a simple interface for loading the input file (and creating objects/input fields for setting the lower/upper boundaries for the report)
2) Create a report template to meet the specifications needed and to handle populating the additional fields that will be computed
3) Use the values calculated in the report to create a prn output file that will have the required data populated once the report is ran

It would help me a lot to get a general idea of the steps that I should use to complete this task.
I've attached an excel file that contains these sheets:
1) Sample input sheet (Input_File)
2) Sample MSA report (Report)
3) Sample output file (Output_File)

I will award full points to someone who provides useful insight on my question. Thanks in advance!
Question by:Lee Richardson
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 2
LVL 39

Expert Comment

ID: 41830613
Except for the prn part, there is no problem.  Would a pdf do?

You didn't attach the spreadsheet.

The whole process shouldn't take more than an hour or two for anyone with a little bit of Access experience.  Very little VBA will be needed.  The biggest hurdle could be the Excel file if it is not consistently formatted.  

If the Excel file is clean and in table format, you can start by opening Access and linking to the file.  There is no need to import the data unless you need to store it for future use.

The calculations can probably all be done in a query or in the report itself so create a query.

Then use the Wizard to create a report based on the query.

The code required is only to open the report or to export it to a PDF or both.  Generally you will want to specify where the PDF gets saved and possibly the name of the file.  Here's a procedure that is probably far more complicated than you need.  It even creates the export folder if necessary.  It loops though a recordset and creates a separate PDF for each record.
Private Sub cmdBlueRptPDF_Click()
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim td As DAO.TableDef
    Dim sPath As String
    Dim sRepPath
    Dim sDate As String
    Dim RecCount As Long
    Dim sFileName As String
    Dim FSO As New FileSystemObject
    DoCmd.RunMacro "mWarningsOff"
    sDate = Format(Date, "yyyymmdd")
    If Right(Me.txtPath, 1) = "\" Then
        sPath = Me.txtPath
        sPath = Me.txtPath & "\"
    End If
   On Error GoTo Error_Proc

    Set db = CurrentDb
    Set qd = db.QueryDefs!qUniqueReps
        qd.Parameters(0).Value = Me.cboProductionID             ' "[forms]![MainForm]![cboProductionID]"
        qd.Parameters(1).Value = Null                           ' "[forms]![MainForm]![txtRepID]"
        qd.Parameters(2).Value = Me.txtFromDT                   ' "[forms]![MainForm]![txtFromDT]"
    Set rs = qd.OpenRecordset

    Me.txtWhichRpt = "PDF"
    Do Until rs.EOF
        Me.txtRepID = rs!RepID
        Call BuildSQL
        sRepPath = sPath & rs!CallCenterCode & "\"  'can only add one level at a time
        If FSO.FolderExists(sRepPath) Then
            FSO.CreateFolder (sRepPath)
        End If
        sRepPath = sRepPath & rs!RepID & "\"        'can only add one level at a time
        If FSO.FolderExists(sRepPath) Then
            FSO.CreateFolder (sRepPath)
        End If
        sFileName = sRepPath & Format(Date, "yyyymmdd") & "_" & sDate & "_" & "BlueRpt_" & rs!CallCenterCode & "_" & rs!RepID & "_" & rs!Rep & ".pdf"
        DoCmd.OutputTo acOutputReport, "rptProfile", acFormatPDF, sFileName, False
        sFileName = sPath & Format(Date, "yyyymmdd") & "_" & sDate & "_" & "BlueRpt_" & rs!CallCenterCode & "_" & rs!RepID & "_" & rs!Rep & ".pdf"
        DoCmd.OutputTo acOutputReport, "rptProfile", acFormatPDF, sFileName, False

    Me.txtRepID = Null
    Me.txtWhichRpt = "RPT"
    sFileName = sPath & Format(Date, "yyyymmdd") & "_" & sDate & "_" & "BlueRpt_ALL" & ".pdf"
    Call BuildSQL
    DoCmd.OutputTo acOutputReport, "rptProfile", acFormatPDF, sFileName, False      'print entire report
    MsgBox "Complete", vbOKOnly
   On Error GoTo 0
   Set FSO = Nothing
   DoCmd.RunMacro "mWarningsOn"
   Exit Sub


    Select Case Err.Number
        Case 2501
            Resume Next
        Case Else
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdBlueRptPDF_Click of VBA Document Form_MainForm"
    End Select
    Resume Exit_Proc

End Sub

Open in new window

This is an example of linking to a spreadsheet in code with the paths hard-coded which I don't recommend.
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12Xml, "ImportedBPOCalls", "S:\Quality Assurance\68_Sales Quality Assurance\CallSelection\Imports\BPOCallsToImport.xlsx", True

Author Comment

by:Lee Richardson
ID: 41830624

It has to be a .prn file because the prn is being read into a VB6 application.
Here's my attached file.
LVL 39

Expert Comment

ID: 41830669
You will need to provide the format of the prn since prn is not a standard file type.
 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

LVL 39

Expert Comment

ID: 41830695
I created the calculation query for you.  I had to import the spreadsheet because it wasn't clean.  If you remove the extra header row and get the columns defined as the correct data type, you can link.

Simply run the query.

Author Comment

by:Lee Richardson
ID: 41830816

Open the save as menu screen in excel.  prn files are standard Microsoft Formatted text files. See below:

LVL 39

Expert Comment

ID: 41832081
Excel has taken liberties with "prn".  Prn is a printer file.  The file that Excel outputs is a fixed width text file.  Access can export this file as .txt and then rename it to .prn but I would still need to know the format.  i.e.  Column order and widths.

I also see that you started a new question.  Please do not start multiple questions on the same topic.  Close either this thread or the new one.
LVL 39

Expert Comment

ID: 41844040
Here are four definitions of prn and as you can see, none is a standard text file.  This is the industry definition of prn.  If Microsoft decides to co-opt the extension for a different use, that's fine but it is not standard.  And I see that you have started yet a third thread.  I won't pollute that thread but I see that so far two other experts have told you that the format is not standard.


All you need to do is to define the columns and widths and any competent programmer or even a novice can manage to export a file in the desired format but they may have to export it as .txt and then include code to rename it to .prn.  Access is very finicky about file extensions for reading and writing external files.
LVL 39

Accepted Solution

PatHartman earned 2000 total points
ID: 41844143
This is what code to write a fixed width text file looks like.  You appear to have only three columns so you'll have only three lines to build strRecord rather than the bunch in the example.  Notice the comments to the right that I used to keep track of where each data field was being written.  Notice how the Space() function is used to "fix" the widths of the text fields.  Take this line for example:
strRecord = strRecord & rsExportFile!EmsNum & Space(12 - Len(rsExportFile!EmsNum))                  'x(12) column32-43
The EMSNum is normally 9 characters but the recipient wanted the width of the column to be 12 characters.  So EMS is concatenated with some number of spaces to come up to a width of 12.  the number of space characters is calculated by subtracting the actual length of the field from the desired length so 12 - 9 = 3.  Three spaces will be concatenated to the end of each EMS number.

To create this file, I was given a spec that said something like:
fld1, format, length, starting position, ending position
fld2, lformat, ength, starting position, ending position
    TempVars("RecCountExp").Value = 0
    Do While Not rsExportFile.EOF
        TempVars("RecCountExp").Value = TempVars("RecCountExp").Value + 1

        strRecord = rsExportFile!AgencyID                                                         'x(09) column 1-9
        strRecord = strRecord & rsExportFile!CarePlanTranType                                     'x(01) column 10
        strRecord = strRecord & rsExportFile!CarePlanNum & Space(10 - Nz(Len(rsExportFile!CarePlanNum), 0))       'x(10) column 11-20
        strRecord = strRecord & rsExportFile!PriorAuthTranType                                    'x(01) column 21
        strRecord = strRecord & rsExportFile!PriorAuthNum & Space(10 - Nz(Len(rsExportFile!PriorAuthNum), 0))     'x(10) column 22-31
        strRecord = strRecord & rsExportFile!EmsNum & Space(12 - Len(rsExportFile!EmsNum))                  'x(12) column32-43
        strRecord = strRecord & rsExportFile!FirstInitial & Space(1 - Len(rsExportFile!FirstInitial))             'x(01) column 44
        If IsNull(rsExportFile!ProviderNum) Then
            strRecord = strRecord & Space(9)
            strRecord = strRecord & rsExportFile!ProviderNum          'x(09) column 45-53
        End If
        If IsNull(rsExportFile!PAAssignmentSub) Then                  'x(01) column 54
            strRecord = strRecord & Space(1)
            strRecord = strRecord & rsExportFile!PAAssignmentSub
        End If
        strRecord = strRecord & rsExportFile!ClinicalNotes & Space(1000 - Nz(Len(rsExportFile!ClinicalNotes), 0)) 'x(1000) column 55-1054
        strRecord = strRecord & rsExportFile!ExternalNotes & Space(1000 - Nz(Len(rsExportFile!ExternalNotes), 0)) 'x(1000) column 1055 - 2054
        strRecord = strRecord & rsExportFile!NumOfLineItems                                       'x(02) column 2055-2056

        If Len(strRecord) <> 2056 Then
            'MsgBox "Invalid recordlength.", vbOKOnly
            TempVars("ErrCountExp").Value = TempVars("ErrCountExp").Value + 1
                rsExportFile!ErrDesc = "Invalid Header Rec length"
            Debug.Print "Header ID = " & rsExportFile!HeaderID & " -- Rec Len = " & Len(strRecord)
            Exit Function
        End If
        strRecord = strRecord & Format(rsExportFile!LineNum, "00")                                'x(02) column 2057-2058
        strRecord = strRecord & rsExportFile!lipastatus & Space(1 - Nz(Len(rsExportFile!lipastatus), 0))          'x(01) column 2059
        strRecord = strRecord & rsExportFile!LITranType                                           'x(01) column 2060
        strRecord = strRecord & rsExportFile!ProcedureCode & Space(5 - Nz(Len(rsExportFile!ProcedureCode), 0))    'x(05) column 2061-2065
        strRecord = strRecord & rsExportFile!Mod1 & Space(2 - Nz(Len(rsExportFile!Mod1), 0))                         'x(02 column 2066-2067
        strRecord = strRecord & rsExportFile!Mod2 & Space(2 - Nz(Len(rsExportFile!Mod2), 0))                         'x(02 column 2068-2069
        strRecord = strRecord & rsExportFile!Mod3 & Space(2 - Nz(Len(rsExportFile!Mod3), 0))                         'x(02 column 2070-2071
        strRecord = strRecord & rsExportFile!Mod4 & Space(2 - Nz(Len(rsExportFile!Mod4), 0))                         'x(02 column 2072-2073
        strRecord = strRecord & rsExportFile!RevenueCode & Space(4 - Nz(Len(rsExportFile!RevenueCode), 0))        'x(04) column 2074-2077
        strRecord = strRecord & rsExportFile!ProcedureCodeMod & Space(2 - Nz(Len(rsExportFile!ProcedureCodeMod), 0)) 'x(02) column 2078-2079
        strRecord = strRecord & rsExportFile!ProcedureCodeList & Space(4 - Nz(Len(rsExportFile!ProcedureCodeList), 0))  'x(04) column 2080-2083
        strRecord = strRecord & Format(rsExportFile!FromDate, "yyyymmdd")                         'x(08) column 2084-2091
        strRecord = strRecord & Format(rsExportFile!ThroughDate, "yyyymmdd")                      'x(08) column 2092-2099
        If IsNull(rsExportFile!FundingSource) Then
            strRecord = strRecord & " "
            strRecord = strRecord & rsExportFile!FundingSource                                       'x(01) column 2100
        End If
        strRecord = strRecord & Format(Nz(rsExportFile!FrequencyNum, "0"), "0000")                        'x(04) column 2101-2104
        strRecord = strRecord & Nz(rsExportFile!FrequencyType, " ")                                        'x(01) column 2105
        strRecord = strRecord & Format(Nz(rsExportFile!PaReqAmt, 0), "000000.00")                       'x(09) column 2106-2114
        strRecord = strRecord & Format(Nz(rsExportFile!PAReqUnits, 0), "0000000")                       'x(07) column 2115-2121
        TempVars("SvcCountExp").Value = TempVars("SvcCountExp").Value + 1
        If Len(strRecord) <> 2121 Then
            'MsgBox "Invalid recordlenngth.", vbOKOnly
            TempVars("ErrCountExp").Value = TempVars("ErrCountExp").Value + 1
                If Nz(rsExportFile!PAReqUnits, 0) < 0 Then
                    rsExportFile!ErrDesc = "Req units is negative"
                    rsExportFile!ErrDesc = "Invalid Detail Rec length"
                End If
            Debug.Print "Detail ID = " & rsExportFile!DetailID & " -- Rec Len = " & Len(strRecord)
            'MsgBox "record skipped due to invalid record length - " & rsExportFile!emsnum, vbOKOnly
            GoTo SkipWrite
        End If
'''fso stuff
        strRecord = Replace$(strRecord, vbNullChar, Chr$(32))           'without this- export is Chinese due to some bug MS introduced in Sept 2013
        fsoFile.WriteLine strRecord
'''internal Access stuff
'        Print #1, strRecord
'''fso stuff
'''internal Access stuff
'    Close #1

Open in new window


Featured Post

Tech or Treat!

Submit an article about your scariest tech experience—and the solution—and you’ll be automatically entered to win one of 4 fantastic tech gadgets.

Question has a verified solution.

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

Windows Server 2003 introduced persistent Volume Shadow Copies and made 2003 a must-do upgrade.  Since then, it's been a must-implement feature for all servers doing any kind of file sharing.
Instead of error trapping or hard-coding for non-updateable fields when using QODBC, let VBA automatically disable them when forms open. This way, users can view but not change the data. Part 1 explained how to use schema tables to do this. Part 2 h…
Finding and deleting duplicate (picture) files can be a time consuming task. My wife and I, our three kids and their families all share one dilemma: Managing our pictures. Between desktops, laptops, phones, tablets, and cameras; over the last decade…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…

604 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