Solved

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
8
41 Views
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!
0
Comment
Question by:Lee Richardson
  • 6
  • 2
8 Comments
 
LVL 34

Expert Comment

by:PatHartman
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
    Else
        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
        Else
            FSO.CreateFolder (sRepPath)
        End If
        sRepPath = sRepPath & rs!RepID & "\"        'can only add one level at a time
        If FSO.FolderExists(sRepPath) Then
        Else
            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
        
        rs.MoveNext
    Loop

    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
    
Exit_Proc:
   On Error GoTo 0
   Set FSO = Nothing
   DoCmd.RunMacro "mWarningsOn"
   Exit Sub

Error_Proc:

    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
    Resume

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
0
 

Author Comment

by:Lee Richardson
ID: 41830624
Pat:

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

Expert Comment

by:PatHartman
ID: 41830669
You will need to provide the format of the prn since prn is not a standard file type.
0
 
LVL 34

Expert Comment

by:PatHartman
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.
Calc.accdb
0
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 

Author Comment

by:Lee Richardson
ID: 41830816
Pat:

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

 Formatted_Text_prn_Microsoft_standard_file
0
 
LVL 34

Expert Comment

by:PatHartman
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.
0
 
LVL 34

Expert Comment

by:PatHartman
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.

http://www.frogmorecs.com/arts/what-is-a-prn-file/
http://www.pcmag.com/article2/0,2817,1945478,00.asp
http://www.openthefile.net/extension/prn
http://filext.com/file-extension/PRN

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.
0
 
LVL 34

Accepted Solution

by:
PatHartman earned 500 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)
        Else
            strRecord = strRecord & rsExportFile!ProviderNum          'x(09) column 45-53
        End If
        If IsNull(rsExportFile!PAAssignmentSub) Then                  'x(01) column 54
            strRecord = strRecord & Space(1)
        Else
            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.Edit
                rsExportFile!ErrDesc = "Invalid Header Rec length"
            rsExportFile.Update
            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 & " "
        Else
            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
            rsExportFile.Edit
                If Nz(rsExportFile!PAReqUnits, 0) < 0 Then
                    rsExportFile!ErrDesc = "Req units is negative"
                Else
                    rsExportFile!ErrDesc = "Invalid Detail Rec length"
                End If
                    
            rsExportFile.Update
            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
SkipWrite:
        rsExportFile.MoveNext
    Loop
    
'''fso stuff
    fsoFile.Close
'''internal Access stuff
'    Close #1

Open in new window

0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Suggested Solutions

Our Group Policy work started with Small Business Server in 2000. Microsoft gave us an excellent OU and GPO model in subsequent SBS editions that utilized WMI filters, OU linking, and VBS scripts. These are some of experiences plus our spending a lo…
Describes a method of obtaining an object variable to an already running instance of Microsoft Access so that it can be controlled via automation.
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.
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.

762 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

Need Help in Real-Time?

Connect with top rated Experts

24 Experts available now in Live!

Get 1:1 Help Now