"Paul H" <no****@nospam. com> wrote in
news:k8******** *********@newsf e2-win.ntli.net:
OK, I tried getting and old Newbury Data ND2500 working using the
"Generic /Text only" driver in Win XP. It prints, but I could not find
a way to set a custom page size that matches the paper I am using. So
there was no way it would ever work.
The customer is happy to buy another Dot Matrix printer because the
ND2500 can be used elsewhere. So which printer should I get that can
plug and play with Access?
Paul
In the very, very olden days one did not need a driver for a dot matrix
printer (maybe other types too, my memory is misty about that). One could
just send the printer control codes directly to the printer and then the
text.
I found this necessary (at least it seemed necessary) to complete multi-
copy (like carbon copies, don't know the proper name for them) purchase
orders which had boxes for various pieces of information. The regular
drivers just would not put things where they were supposed to go
consistently. Every ten printings or so they screwed up and POs had
numbers which had to be accounted for so, trashing a PO was not
permitted.
So I wrote my own: (it's amazing how ones style may change over the
years).
Here's the whole module as the naked procedure may need the other
functions to make sense; I left justified the whole thing to try to
minimize evil linebreaking:
Public Function PrintPO(IDNumbe r As Long)
Dim dbs As Database, rcs As Recordset, tdf As TableDef, dbsPathandName As
String, _
criteria As String, Supplier As String, shipTo As String, _
fileName As String, fileNumber As Integer, _
initialize As String, sixLPI As String, tenPitch As String, _
bold As String, doubleStrike As String, halfLine As String, _
eject As String, nonproportional As String, _
printerCodes As String, retVal As Variant, _
lnStr As String, aLines(60) As String, iCount As Integer, _
accTotal As Currency, warnReAccounts As Boolean, nLine As Integer, _
nStartLine As Integer, nStopLine As Integer, _
Description As String, descriptionArra y As Variant, descriptionStri ng As
String, _
asPerAttached As Boolean, whereString As String, _
rcsAccountNumbe rs As Recordset
Dim mString As String, position As Integer, printString As String, _
pst As Currency, gst As Currency, total As Currency, Amount As Currency
initialize = Chr(27) & Chr(64)
sixLPI = Chr(27) & Chr(50)
tenPitch = Chr(27) & Chr(80)
bold = Chr(27) & Chr(69)
doubleStrike = Chr(27) & Chr(71)
nonproportional = Chr(27) & "p0"
eject = Chr(12)
printerCodes = initialize & sixLPI & tenPitch & bold & doubleStrike &
nonproportional
'verify that printer is ready
If MsgBox("Is printer ready and form inserted?", vbYesNo + vbQuestion,
"Print Purchase Order") = vbYes Then
' get the data
' the connect property of the linked tables gives us the path
' for the tables
' we have to open them directly to use their indexes
Set dbs = CurrentDb()
Set tdf = dbs.TableDefs(" Accounts")
dbsPathandName = Mid(tdf.Connect , 11)
dbs.Close
Set dbs = OpenDatabase(db sPathandName)
'data
' fill the aLines array wiith strings of 80 blank characters
lnStr = Space(80)
For iCount = 1 To 60
aLines(iCount) = lnStr
Next
'deal with accounts first
Set rcs = dbs.OpenRecords et("Accounts Charged", dbOpenTable)
rcs.Index = "Order ID Number"
rcs.Seek "=", IDNumber
Set rcsAccountNumbe rs = dbs.OpenRecords et("Accounts", dbOpenTable)
rcsAccountNumbe rs.Index = "Account Number"
iCount = 4
accTotal = 0
Do While rcs![Order ID Number] = IDNumber
If iCount < 9 Then
If fUseNewNumbers Then
rcsAccountNumbe rs.Seek "=", rcs![Account Number]
aLines(iCount) = stuff(aLines(iC ount), 35, Trim(rcsAccount Numbers![New
Account Number]))
Else
aLines(iCount) = AccountFormat(r cs![Account Number], aLines(iCount))
End If
aLines(iCount) = stuff(aLines(iC ount), 68, padleft(Format( rcs![Amount],
"currency") , 11))
End If
iCount = iCount + 2
accTotal = accTotal + rcs![Amount]
rcs.MoveNext
If rcs.EOF Then
Exit Do
End If
Loop
aLines(10) = stuff(aLines(10 ), 68, padleft(Format( accTotal, "currency") ,
11))
warnReAccounts = iCount > 8
rcs.Close
' sundry data from orders
Set rcs = dbs.OpenRecords et("Orders", dbOpenTable)
rcs.Index = "PrimaryKey "
rcs.Seek "=", IDNumber
aLines(4) = stuff(aLines(4) , 2, rcs![Date])
aLines(4) = stuff(aLines(4) , 13, rcs![Requisitioned By])
aLines(6) = stuff(aLines(6) , 2, rcs![Authorized By])
If rcs![US Funds] Then
aLines(10) = stuff(aLines(10 ), 35, "US Funds")
aLines(57) = stuff(aLines(58 ), 35, "US Funds")
End If
Supplier = rcs![Supplier]
shipTo = rcs![Ship To]
rcs.Close
' supplier
aLines(19) = stuff(aLines(19 ), 6, Supplier)
Set rcs = dbs.OpenRecords et("Suppliers" , dbOpenTable)
rcs.Index = "PrimaryKey "
rcs.Seek "=", Supplier
mString = rcs![Address]
rcs.Close
iCount = 1
Do While Len(mString) > 0
position = InStr(1, mString, Chr(13) + Chr(10), 0)
Select Case position
Case Is > 0
printString = Left(mString, position - 1)
mString = Mid(mString, position + 2)
Case Else
printString = mString
mString = ""
End Select
aLines(19 + iCount) = stuff(aLines(19 + iCount), 6, printString)
iCount = iCount + 1
Loop
' Ship To
aLines(19) = stuff(aLines(19 ), 46, shipTo)
Set rcs = dbs.OpenRecords et("Ship To", dbOpenTable)
rcs.Index = "PrimaryKey "
rcs.Seek "=", shipTo
mString = rcs![Address]
rcs.Close
iCount = 1
Do While Len(mString) > 0
position = InStr(1, mString, Chr(13) + Chr(10), 0)
Select Case position
Case Is > 0
printString = Left(mString, position - 1)
mString = Mid(mString, position + 2)
Case Else
printString = mString
mString = ""
End Select
aLines(19 + iCount) = stuff(aLines(19 + iCount), 46, printString)
iCount = iCount + 1
Loop
'Items
Set rcs = dbs.OpenRecords et("Items Ordered", dbOpenTable)
rcs.Index = "Order ID Number"
rcs.Seek "=", IDNumber
gst = 0
pst = 0
total = 0
nLine = 28
Do While rcs![Order ID Number] = IDNumber
If Not rcs![Unit] = 0 Then
Amount = rcs![Quantity] / rcs![Unit] * rcs![Price]
Else
Amount = 0
End If
nLine = nLine + 1
If nLine < 52 Then
If rcs![Quantity] > 0 Then
aLines(nLine) = stuff(aLines(nL ine), 2, padleft(rcs![Quantity], 6))
aLines(nLine) = stuff(aLines(nL ine), 55, padleft(Format( rcs![Price],
"currency") , 11))
aLines(nLine) = stuff(aLines(nL ine), 66, padleft(rcs![Unit], 4))
aLines(nLine) = stuff(aLines(nL ine), 70, padleft(Format( Amount,
"currency") , 11))
End If
Description = Nz(rcs![Description])
descriptionArra y = memoLines(Descr iption, 45)
nStartLine = LBound(descript ionArray)
nStopLine = UBound(descript ionArray)
For iCount = nStartLine To nStopLine
If nLine < 52 Then
descriptionStri ng = descriptionArra y(iCount)
aLines(nLine) = stuff(aLines(nL ine), 10, descriptionStri ng)
nLine = nLine + 1
Else
Exit For
End If
Next
End If
' add amounts to totaling variables
total = total + Amount
gst = gst + rcs![GST Rate] * Amount
pst = pst + rcs![PST Rate] * Amount
rcs.MoveNext
If rcs.EOF Then
Exit Do
End If
Loop
rcs.Close
rcsAccountNumbe rs.Close
dbs.Close
asPerAttached = (nLine > 51)
If asPerAttached Then
For iCount = 28 To 51
aLines(iCount) = lnStr
Next
aLines(28) = stuff(aLines(28 ), 10, "As Per Attached")
MsgBox "There are too many items to be printed on one Purchase Order" & _
Chr(13) & Chr(10) & "Items will be printed on an attachment."
End If
aLines(51) = stuff(aLines(48 ), 70, padleft(Format( total, "currency") ,
11))
aLines(53) = stuff(aLines(48 ), 70, padleft(Format( gst, "currency") , 11))
aLines(55) = stuff(aLines(48 ), 70, padleft(Format( pst, "currency") , 11))
aLines(57) = stuff(aLines(48 ), 70, padleft(Format( gst + pst + total,
"currency") , 11))
' open the print file
fileName = DLookup("Port", "Printer Port", "ID = 1")
fileNumber = FreeFile()
Open fileName For Output As fileNumber
' printer codes
Print #fileNumber, printerCodes
' data
For iCount = 1 To 60
Print #fileNumber, aLines(iCount)
Next
' return printer to original state
Print #fileNumber, initialize
Close #fileNumber
If warnReAccounts Then
retVal = MsgBox("There are more than three account entries; Please, enter
the extra entries manually after the PO is printed.", vbCritical,
"Warning")
End If
If asPerAttached Then
whereString = "[Order ID Number] =" & IDNumber
DoCmd.OpenRepor t "As Per Attached", acViewPreview, , whereString
End If
End If
End Function
Private Function AccountFormat(a ccountNumber As String, lnStr As String)
As String
accountNumber = padRight(accoun tNumber, 20)
lnStr = stuff(lnStr, 35, Mid(accountNumb er, 1, 2))
lnStr = stuff(lnStr, 39, Mid(accountNumb er, 4, 3))
lnStr = stuff(lnStr, 45, Mid(accountNumb er, 8, 3))
lnStr = stuff(lnStr, 50, Mid(accountNumb er, 12, 3))
lnStr = stuff(lnStr, 55, Mid(accountNumb er, 16, 1))
lnStr = stuff(lnStr, 58, Mid(accountNumb er, 18, 3))
AccountFormat = lnStr
End Function
Private Function padRight(cStrin g, pad As Integer) As String
cString = Trim(cString)
Select Case Len(cString)
Case Is < pad
padRight = cString & String(pad - Len(cString), " ")
Case Is > pad
padRight = Left(cString, pad)
Case Else
padRight = cString
End Select
End Function
Private Function padleft(cString , pad As Integer) As String
cString = Trim(cString)
Select Case Len(cString)
Case Is < pad
padleft = String(pad - Len(cString), " ") & cString
Case Is > pad
padleft = Right(cString, pad)
Case Else
padleft = cString
End Select
End Function
Private Function stuff(original As String, position As Integer, INSERT As
String)
Dim leftPart As String, rightPart As String
leftPart = Left(original, position - 1)
rightPart = Mid(original, position + Len(INSERT))
stuff = leftPart & INSERT & rightPart
End Function
Private Function memoLines(memo As String, lineLength As Integer) As
Variant
Dim workingString As String, iCount As Integer, element As Integer,
character As String
ReDim lineArray(0) As String
workingString = Trim(memo)
element = 0
Do While Len(workingStri ng) > lineLength
ReDim Preserve lineArray(eleme nt)
If (InStr(1, workingString, " ") > lineLength) Or (InStr(1,
workingString, Chr(13)) > lineLength) Then
lineArray(eleme nt) = Trim(Left(worki ngString, lineLength))
workingString = Trim(Mid(workin gString, lineLength + 1))
Else
For iCount = lineLength To 1 Step -1
character = Mid(workingStri ng, iCount, 1)
Select Case character
Case Is = " "
lineArray(eleme nt) = Trim(Left(worki ngString, iCount - 1))
workingString = Trim(Mid(workin gString, iCount + 1))
Exit For
Case Is = Chr(10)
lineArray(eleme nt) = Trim(Left(worki ngString, iCount - 2))
workingString = Trim(Mid(workin gString, iCount + 1))
Exit For
End Select
Next iCount
End If
element = element + 1
Loop
Do While InStr(1, workingString, Chr(13)) > 0
ReDim Preserve lineArray(eleme nt)
iCount = InStr(1, workingString, Chr(13))
lineArray(eleme nt) = Trim(Left(worki ngString, iCount - 1))
workingString = Trim(Mid(workin gString, iCount + 2))
element = element + 1
Loop
If Len(workingStri ng) > 0 Then
ReDim Preserve lineArray(eleme nt)
lineArray(eleme nt) = workingString
End If
memoLines = lineArray
End Function
--
Lyle Fairfield
