Printing
I have one VB application that perfectly print the text file. First, it will get the list of the text file and move it to another list. When the print button is pressed, the text file in the new list is printed.
There is another combo box to choose which month the users are willing to print. If the users choose January then all January data from the text file only are printed and so on.
The problem :
When I choose January, the November data is also be printed. The second one, when I choose February, the December is also be printed. How to do it? I have really no idea.
Here is the code for the print button.
Private Sub cmdPrint_Click()
Dim PrintStatus, Printable, allMonth, Found As Boolean
Dim tString, Header1, Header2 As String
Dim sIndexNum, pMonth, pYear, pProject As String
Dim word, word1, file As String
Dim RefNum, sDate, Subject, TempSubject, SendTo, Author As String
Dim ColWidth1, ColWidth2, ColWidth3, ColWidth4, ColWidth5 As Integer
Dim I, C, round, sPointer, TempPointer, pNum As Integer
If cmbMonth.text = "" Then
Beep
request = MsgBox("Please select a Month to print", vbExclamation, "Error Message")
GoTo MainError
End If
If lslSelected.List(0) = "" Then
Beep
request = MsgBox("No Project is selected for printing, please select again", vbExclamation, "Error Message")
GoTo MainError
End If
If txtYear.text = "" Then
Beep
request = MsgBox("Please keyin the year to print", vbExclamation, "Error Message")
GoTo MainError
End If
Set fso = CreateObject("Scripting.Fi
' copy selected data files to temp folder for printing
If Dir("c:\windows\temp\") = "" Then
request = MsgBox("Error, temp folder c:\windows\temp does not exist, please create.", vbCritical, "Message")
GoTo MainError
Else
For Index = 0 To lslSelected.ListCount
If InStr(1, lslSelected.List(Index), "SIN Projects", vbTextCompare) Then
sIndexNum = "SINRefNum"
Else
If InStr(1, lslSelected.List(Index), "/", vbTextCompare) Then
sIndexNum = Replace(lslSelected.List(I
Else
sIndexNum = lslSelected.List(Index) & "*"
End If
End If
If Right(sIndexNum, 1) = "*" Then
file = Dir(App.Path + "\data\" + sIndexNum + ".txt")
Do While file <> ""
FileCopy (App.Path + "\data\" + file), ("c:\windows\temp\" + Left(file, Len(file) - 4) + ".pnp")
file = Dir
Loop
Else
FileCopy (App.Path + "\data\" + sIndexNum + ".txt"), ("c:\windows\temp\" + sIndexNum + ".pnp")
End If
Next Index
End If
' Set Column Width of print out
ColWidth1 = 20
ColWidth2 = 13
ColWidth3 = 85
ColWidth4 = 35
ColWidth5 = 25
allMonth = False
pMonth = Str(cmbMonth.ListIndex)
If pMonth = 0 Then
allMonth = True
End If
pYear = txtYear.text
pMonth = pMonth + "/" + pYear
pMonth = Trim(pMonth)
Index = 0
' process files from the selected list until complete
Do While lslSelected.List(Index) <> ""
' Set Printer Parameters
Printer.FontName = "Courier New"
Printer.Orientation = 2
' format filename from selected list for process
If InStr(1, lslSelected.List(Index), "SIN Projects", vbTextCompare) Then
pProject = "SIN Projects"
sIndexNum = "SINRefNum"
Else
If InStr(1, lslSelected.List(Index), "/", vbTextCompare) Then
sPointer = InStr(1, lslSelected.List(Index), "/", vbTextCompare)
pProject = Left(lslSelected.List(Inde
sIndexNum = Replace(lslSelected.List(I
Else
sIndexNum = lslSelected.List(Index)
End If
End If
' open txt file for input
Open "c:\windows\temp\" + sIndexNum + ".pnp" For Input As #1
Line Input #1, tString
' set starting page number
pNum = 1
' set headers
If allMonth = False Then
Header1 = "Reference Number List of JRP Project " & pProject & " for the month of " & cmbMonth.text & " " & txtYear.text
Else
Header1 = "Reference Number List of JRP Project " & pProject & " for the year " & txtYear.text
End If
Header2 = "Ref Number Date Subject Send To Author"
' print header
Printer.FontSize = 14
Printer.FontBold = True
Printer.Print
Printer.Print
Printer.Print Header1
Printer.Print
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print Header2
Printer.Print
Printer.FontSize = 8
Printer.FontBold = False
' readin, process and print data
Do While (EOF(1) <> True) And (tString <> "")
' initialize print string
word = ""
word1 = ""
Printable = False
sPointer = 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
RefNum = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
For C = 1 To (ColWidth1 - Len(RefNum))
RefNum = RefNum + " "
Next C
word = word + RefNum
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
sDate = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' check whether record belong to the selected month
' if yes set 'printable' to 'true'
If InStr(1, sDate, pMonth, vbTextCompare) Or (allMonth = True) Then
Printable = True
End If
For C = 1 To (ColWidth2 - Len(sDate))
sDate = sDate + " "
Next C
word = word + sDate
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
Subject = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' if subject field cannot fit into the column width
If Len(Subject) > ColWidth3 Then
TempSubject = Left(Subject, ColWidth3)
TempPointer = 0
I = ColWidth3
Found = False
Do While (I <> 0) And (Found = False)
If Mid(TempSubject, I, 1) = " " Then
TempPointer = I
Found = True
Else
I = I - 1
End If
Loop
word1 = word1 + Right(Subject, Len(Subject) - TempPointer)
Subject = Left(Subject, TempPointer - 1)
End If
For C = 1 To (ColWidth3 - Len(Subject))
Subject = Subject + " "
Next C
word = word + Subject
If word1 <> "" Then
For I = 1 To ColWidth1 + ColWidth2
word1 = " " + word1
Next I
For I = 1 To ColWidth1 + ColWidth2 + ColWidth3 - Len(word1)
word1 = word1 + " "
Next I
End If
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
SendTo = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' if sendto field cannot fit into the column width
If Len(SendTo) > ColWidth4 Then
TempSendTo = Left(SendTo, ColWidth3)
TempPointer = 0
I = ColWidth4
Found = False
Do While (I <> 0) And (Found = False)
If Mid(TempSendTo, I, 1) = " " Then
TempPointer = I
Found = True
Else
I = I - 1
End If
Loop
word1 = word1 + Right(SendTo, Len(SendTo) - TempPointer)
SendTo = Left(SendTo, TempPointer - 1)
End If
For C = 1 To (ColWidth4 - Len(SendTo))
SendTo = SendTo + " "
Next C
word = word + SendTo
If word1 <> "" Then
If Left(word1, 1) <> " " Then
For I = 1 To ColWidth1 + ColWidth2 + ColWidth3
word1 = " " + word1
Next I
End If
End If
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
Author = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
For C = 1 To (ColWidth5 - Len(Author))
Author = Author + " "
Next C
word = word + Author
End If
' Print the Word if printable
If Printable Then
' Start a new page if needed.
If Printer.CurrentY + (84 * Printer.FontSize) > Printer.ScaleHeight Then
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print "Page " & pNum
Printer.FontSize = 8
Printer.FontBold = False
Printer.NewPage
pNum = pNum + 1
' print header
Printer.FontSize = 14
Printer.FontBold = True
Printer.Print
Printer.Print
Printer.Print Header1
Printer.Print
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print Header2
Printer.Print
Printer.FontSize = 8
Printer.FontBold = False
End If
Printer.Print word
If word1 <> "" Then
Printer.Print word1
End If
Printer.Print
End If
Line Input #1, tString
Loop
If tString <> "" Then
' initialize print string
word = ""
word1 = ""
Printable = False
sPointer = 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
RefNum = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
For C = 1 To (ColWidth1 - Len(RefNum))
RefNum = RefNum + " "
Next C
word = word + RefNum
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
sDate = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
If InStr(1, sDate, pMonth, vbTextCompare) Or (allMonth = True) Then
Printable = True
End If
For C = 1 To (ColWidth2 - Len(sDate))
sDate = sDate + " "
Next C
word = word + sDate
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
Subject = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' if subject field cannot fit into the column width
If Len(Subject) > ColWidth3 Then
TempSubject = Left(Subject, ColWidth3)
TempPointer = 0
I = ColWidth3
Found = False
Do While (I <> 0) And (Found = False)
If Mid(TempSubject, I, 1) = " " Then
TempPointer = I
Found = True
Else
I = I - 1
End If
Loop
word1 = word1 + Right(Subject, Len(Subject) - TempPointer)
Subject = Left(Subject, TempPointer - 1)
End If
For C = 1 To (ColWidth3 - Len(Subject))
Subject = Subject + " "
Next C
word = word + Subject
If word1 <> "" Then
For I = 1 To ColWidth1 + ColWidth2
word1 = " " + word1
Next I
For I = 1 To ColWidth1 + ColWidth2 + ColWidth3 - Len(word1)
word1 = word1 + " "
Next I
End If
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
SendTo = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' if sendto field cannot fit into the column width
If Len(SendTo) > ColWidth4 Then
TempSendTo = Left(SendTo, ColWidth3)
TempPointer = 0
I = ColWidth4
Found = False
Do While (I <> 0) And (Found = False)
If Mid(TempSendTo, I, 1) = " " Then
TempPointer = I
Found = True
Else
I = I - 1
End If
Loop
word1 = word1 + Right(SendTo, Len(SendTo) - TempPointer)
SendTo = Left(SendTo, TempPointer - 1)
End If
For C = 1 To (ColWidth4 - Len(SendTo))
SendTo = SendTo + " "
Next C
word = word + SendTo
If word1 <> "" Then
If Left(word1, 1) <> " " Then
For I = 1 To ColWidth1 + ColWidth2 + ColWidth3
word1 = " " + word1
Next I
End If
End If
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
Author = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
For C = 1 To (ColWidth5 - Len(Author))
Author = Author + " "
Next C
word = word + Author
End If
' Print the Word if printable
If Printable Then
' Start a new page if needed.
If Printer.CurrentY + (84 * Printer.FontSize) > Printer.ScaleHeight Then
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print "Page " & pNum
Printer.FontSize = 8
Printer.FontBold = False
Printer.NewPage
pNum = pNum + 1
' print header
Printer.FontSize = 14
Printer.FontBold = True
Printer.Print
Printer.Print
Printer.Print Header1
Printer.Print
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print Header2
Printer.Print
Printer.FontSize = 8
Printer.FontBold = False
End If
Printer.Print word
If word1 <> "" Then
Printer.Print word1
End If
Printer.Print
End If
End If
Printer.CurrentY = 10978
Printer.CurrentX = 0
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print "Page " & pNum
Printer.FontSize = 8
Printer.FontBold = False
Printer.EndDoc
SubError:
Close #1
Set a = fso.GetFile("c:\windows\te
a.Delete
lslSelected.RemoveItem (Index)
Loop
request = MsgBox("Finish Printing", vbOKOnly, "Message")
MainError:
End Sub
There is another combo box to choose which month the users are willing to print. If the users choose January then all January data from the text file only are printed and so on.
The problem :
When I choose January, the November data is also be printed. The second one, when I choose February, the December is also be printed. How to do it? I have really no idea.
Here is the code for the print button.
Private Sub cmdPrint_Click()
Dim PrintStatus, Printable, allMonth, Found As Boolean
Dim tString, Header1, Header2 As String
Dim sIndexNum, pMonth, pYear, pProject As String
Dim word, word1, file As String
Dim RefNum, sDate, Subject, TempSubject, SendTo, Author As String
Dim ColWidth1, ColWidth2, ColWidth3, ColWidth4, ColWidth5 As Integer
Dim I, C, round, sPointer, TempPointer, pNum As Integer
If cmbMonth.text = "" Then
Beep
request = MsgBox("Please select a Month to print", vbExclamation, "Error Message")
GoTo MainError
End If
If lslSelected.List(0) = "" Then
Beep
request = MsgBox("No Project is selected for printing, please select again", vbExclamation, "Error Message")
GoTo MainError
End If
If txtYear.text = "" Then
Beep
request = MsgBox("Please keyin the year to print", vbExclamation, "Error Message")
GoTo MainError
End If
Set fso = CreateObject("Scripting.Fi
' copy selected data files to temp folder for printing
If Dir("c:\windows\temp\") = "" Then
request = MsgBox("Error, temp folder c:\windows\temp does not exist, please create.", vbCritical, "Message")
GoTo MainError
Else
For Index = 0 To lslSelected.ListCount
If InStr(1, lslSelected.List(Index), "SIN Projects", vbTextCompare) Then
sIndexNum = "SINRefNum"
Else
If InStr(1, lslSelected.List(Index), "/", vbTextCompare) Then
sIndexNum = Replace(lslSelected.List(I
Else
sIndexNum = lslSelected.List(Index) & "*"
End If
End If
If Right(sIndexNum, 1) = "*" Then
file = Dir(App.Path + "\data\" + sIndexNum + ".txt")
Do While file <> ""
FileCopy (App.Path + "\data\" + file), ("c:\windows\temp\" + Left(file, Len(file) - 4) + ".pnp")
file = Dir
Loop
Else
FileCopy (App.Path + "\data\" + sIndexNum + ".txt"), ("c:\windows\temp\" + sIndexNum + ".pnp")
End If
Next Index
End If
' Set Column Width of print out
ColWidth1 = 20
ColWidth2 = 13
ColWidth3 = 85
ColWidth4 = 35
ColWidth5 = 25
allMonth = False
pMonth = Str(cmbMonth.ListIndex)
If pMonth = 0 Then
allMonth = True
End If
pYear = txtYear.text
pMonth = pMonth + "/" + pYear
pMonth = Trim(pMonth)
Index = 0
' process files from the selected list until complete
Do While lslSelected.List(Index) <> ""
' Set Printer Parameters
Printer.FontName = "Courier New"
Printer.Orientation = 2
' format filename from selected list for process
If InStr(1, lslSelected.List(Index), "SIN Projects", vbTextCompare) Then
pProject = "SIN Projects"
sIndexNum = "SINRefNum"
Else
If InStr(1, lslSelected.List(Index), "/", vbTextCompare) Then
sPointer = InStr(1, lslSelected.List(Index), "/", vbTextCompare)
pProject = Left(lslSelected.List(Inde
sIndexNum = Replace(lslSelected.List(I
Else
sIndexNum = lslSelected.List(Index)
End If
End If
' open txt file for input
Open "c:\windows\temp\" + sIndexNum + ".pnp" For Input As #1
Line Input #1, tString
' set starting page number
pNum = 1
' set headers
If allMonth = False Then
Header1 = "Reference Number List of JRP Project " & pProject & " for the month of " & cmbMonth.text & " " & txtYear.text
Else
Header1 = "Reference Number List of JRP Project " & pProject & " for the year " & txtYear.text
End If
Header2 = "Ref Number Date Subject Send To Author"
' print header
Printer.FontSize = 14
Printer.FontBold = True
Printer.Print
Printer.Print
Printer.Print Header1
Printer.Print
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print Header2
Printer.Print
Printer.FontSize = 8
Printer.FontBold = False
' readin, process and print data
Do While (EOF(1) <> True) And (tString <> "")
' initialize print string
word = ""
word1 = ""
Printable = False
sPointer = 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
RefNum = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
For C = 1 To (ColWidth1 - Len(RefNum))
RefNum = RefNum + " "
Next C
word = word + RefNum
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
sDate = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' check whether record belong to the selected month
' if yes set 'printable' to 'true'
If InStr(1, sDate, pMonth, vbTextCompare) Or (allMonth = True) Then
Printable = True
End If
For C = 1 To (ColWidth2 - Len(sDate))
sDate = sDate + " "
Next C
word = word + sDate
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
Subject = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' if subject field cannot fit into the column width
If Len(Subject) > ColWidth3 Then
TempSubject = Left(Subject, ColWidth3)
TempPointer = 0
I = ColWidth3
Found = False
Do While (I <> 0) And (Found = False)
If Mid(TempSubject, I, 1) = " " Then
TempPointer = I
Found = True
Else
I = I - 1
End If
Loop
word1 = word1 + Right(Subject, Len(Subject) - TempPointer)
Subject = Left(Subject, TempPointer - 1)
End If
For C = 1 To (ColWidth3 - Len(Subject))
Subject = Subject + " "
Next C
word = word + Subject
If word1 <> "" Then
For I = 1 To ColWidth1 + ColWidth2
word1 = " " + word1
Next I
For I = 1 To ColWidth1 + ColWidth2 + ColWidth3 - Len(word1)
word1 = word1 + " "
Next I
End If
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
SendTo = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' if sendto field cannot fit into the column width
If Len(SendTo) > ColWidth4 Then
TempSendTo = Left(SendTo, ColWidth3)
TempPointer = 0
I = ColWidth4
Found = False
Do While (I <> 0) And (Found = False)
If Mid(TempSendTo, I, 1) = " " Then
TempPointer = I
Found = True
Else
I = I - 1
End If
Loop
word1 = word1 + Right(SendTo, Len(SendTo) - TempPointer)
SendTo = Left(SendTo, TempPointer - 1)
End If
For C = 1 To (ColWidth4 - Len(SendTo))
SendTo = SendTo + " "
Next C
word = word + SendTo
If word1 <> "" Then
If Left(word1, 1) <> " " Then
For I = 1 To ColWidth1 + ColWidth2 + ColWidth3
word1 = " " + word1
Next I
End If
End If
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
Author = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
For C = 1 To (ColWidth5 - Len(Author))
Author = Author + " "
Next C
word = word + Author
End If
' Print the Word if printable
If Printable Then
' Start a new page if needed.
If Printer.CurrentY + (84 * Printer.FontSize) > Printer.ScaleHeight Then
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print "Page " & pNum
Printer.FontSize = 8
Printer.FontBold = False
Printer.NewPage
pNum = pNum + 1
' print header
Printer.FontSize = 14
Printer.FontBold = True
Printer.Print
Printer.Print
Printer.Print Header1
Printer.Print
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print Header2
Printer.Print
Printer.FontSize = 8
Printer.FontBold = False
End If
Printer.Print word
If word1 <> "" Then
Printer.Print word1
End If
Printer.Print
End If
Line Input #1, tString
Loop
If tString <> "" Then
' initialize print string
word = ""
word1 = ""
Printable = False
sPointer = 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
RefNum = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
For C = 1 To (ColWidth1 - Len(RefNum))
RefNum = RefNum + " "
Next C
word = word + RefNum
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
sDate = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
If InStr(1, sDate, pMonth, vbTextCompare) Or (allMonth = True) Then
Printable = True
End If
For C = 1 To (ColWidth2 - Len(sDate))
sDate = sDate + " "
Next C
word = word + sDate
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
Subject = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' if subject field cannot fit into the column width
If Len(Subject) > ColWidth3 Then
TempSubject = Left(Subject, ColWidth3)
TempPointer = 0
I = ColWidth3
Found = False
Do While (I <> 0) And (Found = False)
If Mid(TempSubject, I, 1) = " " Then
TempPointer = I
Found = True
Else
I = I - 1
End If
Loop
word1 = word1 + Right(Subject, Len(Subject) - TempPointer)
Subject = Left(Subject, TempPointer - 1)
End If
For C = 1 To (ColWidth3 - Len(Subject))
Subject = Subject + " "
Next C
word = word + Subject
If word1 <> "" Then
For I = 1 To ColWidth1 + ColWidth2
word1 = " " + word1
Next I
For I = 1 To ColWidth1 + ColWidth2 + ColWidth3 - Len(word1)
word1 = word1 + " "
Next I
End If
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
SendTo = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
' if sendto field cannot fit into the column width
If Len(SendTo) > ColWidth4 Then
TempSendTo = Left(SendTo, ColWidth3)
TempPointer = 0
I = ColWidth4
Found = False
Do While (I <> 0) And (Found = False)
If Mid(TempSendTo, I, 1) = " " Then
TempPointer = I
Found = True
Else
I = I - 1
End If
Loop
word1 = word1 + Right(SendTo, Len(SendTo) - TempPointer)
SendTo = Left(SendTo, TempPointer - 1)
End If
For C = 1 To (ColWidth4 - Len(SendTo))
SendTo = SendTo + " "
Next C
word = word + SendTo
If word1 <> "" Then
If Left(word1, 1) <> " " Then
For I = 1 To ColWidth1 + ColWidth2 + ColWidth3
word1 = " " + word1
Next I
End If
End If
End If
sPointer = InStr(sPointer, tString, Chr(2), vbTextCompare) + 1
If sPointer >= Len(tString) Then
request = MsgBox("Missing Field in database, please check with project secretary.", vbOKOnly, "Error Message")
GoTo SubError
Else
Author = Mid(tString, sPointer, InStr(sPointer, tString, Chr(2), vbTextCompare) - sPointer)
For C = 1 To (ColWidth5 - Len(Author))
Author = Author + " "
Next C
word = word + Author
End If
' Print the Word if printable
If Printable Then
' Start a new page if needed.
If Printer.CurrentY + (84 * Printer.FontSize) > Printer.ScaleHeight Then
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print "Page " & pNum
Printer.FontSize = 8
Printer.FontBold = False
Printer.NewPage
pNum = pNum + 1
' print header
Printer.FontSize = 14
Printer.FontBold = True
Printer.Print
Printer.Print
Printer.Print Header1
Printer.Print
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print Header2
Printer.Print
Printer.FontSize = 8
Printer.FontBold = False
End If
Printer.Print word
If word1 <> "" Then
Printer.Print word1
End If
Printer.Print
End If
End If
Printer.CurrentY = 10978
Printer.CurrentX = 0
Printer.FontSize = 10
Printer.FontBold = True
Printer.Print "Page " & pNum
Printer.FontSize = 8
Printer.FontBold = False
Printer.EndDoc
SubError:
Close #1
Set a = fso.GetFile("c:\windows\te
a.Delete
lslSelected.RemoveItem (Index)
Loop
request = MsgBox("Finish Printing", vbOKOnly, "Message")
MainError:
End Sub
ASKER
Dear Jacamar, thanks for your reply. Yes can you show me the solution for it?
Thnak you
Thnak you
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:
-->Accept Flembosa's comment as Answer
Please leave any comments here within the next seven days.
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER
GPrentice00
Cleanup Volunteer
I will leave a recommendation in the Cleanup topic area that this question is:
-->Accept Flembosa's comment as Answer
Please leave any comments here within the next seven days.
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER
GPrentice00
Cleanup Volunteer
It makes some sense that this error occurs because the program is for somereason recognizing month 1 and 11 as being equal and 2 and 12. You should redefine the way your program identifies the item from the combobox. How are you doing it now? Do you need to know another way?