Hi all, we have been upgraded to Access 2007 without our knowledge of it coming and a critical program for us is halted now as a result. Some of the code that it is stopping on is:
Dim xlTemplateWorksheet As Excel.Worksheet
xlTemplateWorksheet.select
I get an Access error box that says: Automation Error, The server threw an exception. Code for the function is below.
What the heck does that mean? If anyone can assist, it would be greatly appreciated. I've never even used MS Access 2007 - not even once yet! Please help!
Additionally, does the holding of the shift button now not work to bring up the database window? We set the switchboard to come up for our users so they can't see the database objects, now we are having a heck of a time too!
Thank you, Tina
Private Function fblnMapPRData2Form(objWorkBook As Excel.Workbook) As Boolean
Dim xlTemplateWorksheet As Excel.Worksheet
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim RS_Item As DAO.Recordset
Dim RS_Detail As DAO.Recordset
Dim sngTotalPage1Cost As Single
Dim sngTotalPage2Cost As Single
Dim i As Long
Dim j As Long
Dim strTmp As String
Dim datMaterialRequired As Date
Dim strFirstName As String
Dim strLastName As String
Dim strName As String
Dim strPRType As String
Dim strDecriptionLeftOver As String
Dim intWrapPoint As Integer
Dim intAsciCode As Integer
Dim sngRowHeight As Single
Dim intPRSeq As Integer ''Order of items on PR used for spotbuy to identify items MTMT 042705
Const cintDescriptionCellLength As Integer = 53
fblnMapPRData2Form = False
On Error GoTo ERRHD
gstrBlanketReleaseClause3405 = ""
gblnPRPage2Used = False
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM Tbl_PRRFQList WHERE [ID]= " & gudtPR_RFQList.Id)
If gudtPR_RFQList.FormType = 1 Then
Set RS_Item = db.OpenRecordset("SELECT * FROM Tbl_PRSpotBuy WHERE [ID]= " & gudtPR_RFQList.Id)
Else
Set RS_Item = db.OpenRecordset("SELECT * FROM Tbl_PRBlanket WHERE [ID]= " & gudtPR_RFQList.Id)
End If
rs.MoveFirst 'There must be one and only one record
RS_Item.MoveFirst 'There must be one and only one record
Set xlTemplateWorksheet = objWorkBook.Worksheets(gcstrPRSheet1)
xlTemplateWorksheet.Select
DoEvents
'Date material required
Set RS_Detail = db.OpenRecordset("SELECT * FROM Tbl_PRItemDetail WHERE [ID]= " & gudtPR_RFQList.Id & " AND ISDATE([DateRequiredComplete]) ORDER BY CDATE([DateRequiredComplete]) DESC")
If RS_Detail.RecordCount > 0 Then
RS_Detail.MoveFirst 'Get the lasted data
If Not IsNull(RS_Detail("DateRequiredComplete").Value) Then
datMaterialRequired = RS_Detail("DateRequiredComplete").Value
xlTemplateWorksheet.Cells.Item(3, "V").Value = datMaterialRequired
End If
End If
'Select PR TYPE:
strPRType = Trim(RS_Item("PRType"))
Select Case strPRType:
Case "NEW", "ENG CHG", "RE-BUY", "RE-USE"
If gudtPR_RFQList.FormType = 1 Then
xlTemplateWorksheet.Cells.Item(2, "F").Value = 3
Else
xlTemplateWorksheet.Cells.Item(2, "F").Value = 2
End If
Case "INCREASE", "DECREASE", "CANCELLATION"
If gudtPR_RFQList.FormType = 1 Then
xlTemplateWorksheet.Cells.Item(2, "F").Value = 5
Else
xlTemplateWorksheet.Cells.Item(2, "F").Value = 6
End If
'' Case "CANCELLATION"
'' xlTemplateWorksheet.Cells.Item(2, "F").Value = 8
Case Else
MsgBox "Unknown PR Type"
xlTemplateWorksheet.Cells.Item(2, "F").Value = 1
End Select
'' 'PR Number, extracing the letter part and the number part
'' xlTemplateWorksheet.Cells.Item(1, "AN").Text = gudtPR_RFQList.PRNumber
'Olimpic Location Code:
xlTemplateWorksheet.Cells.Item(2, "AY").Value = 4
'Ship to Code
xlTemplateWorksheet.Cells.Item(9, "U").Value = 39
Set RS_Detail = db.OpenRecordset("SELECT * FROM Tbl_PRItemDetail WHERE [ID]= " & gudtPR_RFQList.Id & " ORDER BY [AutoSequence] ASC")
RS_Detail.MoveFirst 'There must be one and only one record
'Reference PO
xlTemplateWorksheet.Cells.Item(1, "R").Value = RS_Detail("ReferencePO").Value
'Blanket order number
If gudtPR_RFQList.FormType = 2 Then
xlTemplateWorksheet.Cells.Item(2, "S").Value = RS_Item("BlanketOrderNumber").Value
End If
'Date PO required
'xlTemplateWorksheet.Cells.Item(3, "AD").Value = "ASAP"
'Requestor info
strName = Trim(rs("RequestorName").Value)
Call gsubGetFirst_LastNames(strName, strFirstName, strLastName)
xlTemplateWorksheet.Cells.Item(4, "G").Value = strFirstName
xlTemplateWorksheet.Cells.Item(5, "G").Value = strLastName
xlTemplateWorksheet.Cells.Item(6, "G").Value = rs("MailCode").Value
xlTemplateWorksheet.Cells.Item(7, "G").Value = rs("PhoneNumber").Value
xlTemplateWorksheet.Cells.Item(8, "G").Value = rs("Email").Value
xlTemplateWorksheet.Cells.Item(9, "G").Value = rs("FaxNumber").Value
xlTemplateWorksheet.Cells.Item(10, "G").Value = rs("Pager").Value
'Approver Info
strName = gudtApprovalOptions.strapprover
Call gsubGetFirst_LastNames(strName, strFirstName, strLastName)
xlTemplateWorksheet.Cells.Item(33, "B").Value = strFirstName & " " & strLastName
'Added by MTMT 042605
xlTemplateWorksheet.Range("E11").Value = 2 ''Default it to NO 'Capital field
'Added by MTMT 042605
'Spot buy or not
If gudtPR_RFQList.FormType = 1 Then
xlTemplateWorksheet.Cells.Item(11, "H").Value = "x"
xlTemplateWorksheet.Cells.Item(11, "H").Font.Size = 16
xlTemplateWorksheet.Cells.Item(11, "H").Font.Bold = True
xlTemplateWorksheet.Cells.Item(11, "H").VerticalAlignment = xlCenter
Else
xlTemplateWorksheet.Cells.Item(11, "M").Value = "x"
xlTemplateWorksheet.Cells.Item(11, "M").Font.Size = 16
xlTemplateWorksheet.Cells.Item(11, "M").Font.Bold = True
xlTemplateWorksheet.Cells.Item(11, "M").VerticalAlignment = xlCenter
End If
'Part supplier info
xlTemplateWorksheet.Cells.Item(5, "R").Value = "TBD"
'No hazardous
xlTemplateWorksheet.Cells.Item(5, "Y").Value = 3
'Tax Code
xlTemplateWorksheet.Cells.Item(5, "AN").Value = 4
'Supplier info
If gudtPR_RFQList.FormType = 1 Then
If RS_Item("SuggestedSupplier").Value = "(TBD)" Then
xlTemplateWorksheet.Cells.Item(7, "AB").Value = "TBD"
Else
xlTemplateWorksheet.Cells.Item(7, "AB").Value = RS_Item("SuggestedSupplier").Value
End If
Else
xlTemplateWorksheet.Cells.Item(7, "AB").Value = RS_Item("BlanketSupplier").Value
End If
xlTemplateWorksheet.Cells.Item(5, "AZ").Value = "'" & Format(RS_Item("DunsNumber").Value, "000000000")
''MTMT 042705 populate program name in additional desc field
xlTemplateWorksheet.Range("AK3").Value = gstrProgram
'Detailed items
RS_Detail.MoveFirst
i = 0
intPRSeq = 1
gintNumOfPages4Sheet1 = 1 'Now always
Do While Not RS_Detail.EOF
i = i + 1
If i > 10 Then
GoTo PAGE2
ElseIf i > 1 And i <= 10 Then
RS_Detail.MoveNext
intPRSeq = intPRSeq + 1 ''MTMT 042705
If RS_Detail.EOF Then GoTo FINISH
End If
xlTemplateWorksheet.Cells.Item(19 + i, "A").Value = RS_Detail("Quantity").Value
xlTemplateWorksheet.Cells.Item(19 + i, "C").Value = RS_Detail("UnitofMeasure").Value
If gudtPR_RFQList.FormType = 2 Then 'Blanket
xlTemplateWorksheet.Cells.Item(19 + i, "J").Value = RS_Detail("CommonCode")
End If
'Bookmark MT 042705
''************************************************
'Get the sequence number if spotbuy
If gudtPR_RFQList.FormType = 1 Then ' Spot Buy
xlTemplateWorksheet.Cells.Item(19 + i, "F").Value = intPRSeq
End If
''************************************************
strTmp = gstrGetTotalDescription(RS_Item, RS_Detail)
''************************************************
''MT 042705 begin
gstrBlanketReleaseClause3405 = gstrBlanketReleaseClause3405 & RS_Detail("CommonCode") & " - " & strTmp & " "
''MT 042705 end
''************************************************
xlTemplateWorksheet.Cells.Item(19 + i, "AZ").NumberFormat = "0.0000"
xlTemplateWorksheet.Cells.Item(19 + i, "AZ").Value = Format(RS_Detail("UnitCost").Value, "0.0000")
strDecriptionLeftOver = strTmp
Do While strDecriptionLeftOver <> ""
If Len(strDecriptionLeftOver) > cintDescriptionCellLength Then
intWrapPoint = cintDescriptionCellLength
For j = cintDescriptionCellLength + 1 To 2 Step -1
intAsciCode = Asc(Mid(strDecriptionLeftOver, j, 1))
If (intAsciCode < 97 Or intAsciCode > 122) And (intAsciCode < 65 Or intAsciCode > 90) And (intAsciCode < 48 Or intAsciCode > 57) Then
intWrapPoint = j
Exit For
End If
Next j
If intWrapPoint = 2 Or intWrapPoint = cintDescriptionCellLength + 1 Then intWrapPoint = cintDescriptionCellLength
xlTemplateWorksheet.Cells.Item(19 + i, "O").Value = Mid(strDecriptionLeftOver, 1, intWrapPoint)
strDecriptionLeftOver = Mid(strDecriptionLeftOver, intWrapPoint + 1)
i = i + 1
If i > 10 Then GoTo PAGE2
Else
xlTemplateWorksheet.Cells.Item(19 + i, "O").Value = strDecriptionLeftOver
strDecriptionLeftOver = ""
End If
Loop
Loop
GoTo FINISH
PAGE2:
gblnPRPage2Used = True
Set xlTemplateWorksheet = objWorkBook.Worksheets(gcstrPRSheet2)
sngRowHeight = xlTemplateWorksheet.Cells.Range("A3:A3").RowHeight
xlTemplateWorksheet.Cells.Range("A3:A500").RowHeight = 0
'Finish up the left over description from sheet 1 if any.
i = 0
Do While strDecriptionLeftOver <> ""
i = i + 1
If i + 2 > 500 Then
MsgBox "There are too many items on this PR. Please delete some items and try again.", vbCritical, "NAC Enterprise System"
GoTo FINISH
End If
If Len(strDecriptionLeftOver) > cintDescriptionCellLength Then
intWrapPoint = cintDescriptionCellLength
For j = cintDescriptionCellLength + 1 To 2 Step -1
intAsciCode = Asc(Mid(strDecriptionLeftOver, j, 1))
If (intAsciCode < 97 Or intAsciCode > 122) And (intAsciCode < 65 Or intAsciCode > 90) And (intAsciCode < 48 Or intAsciCode > 57) Then
intWrapPoint = j
Exit For
End If
Next j
If intWrapPoint = 2 Or intWrapPoint = cintDescriptionCellLength + 1 Then intWrapPoint = cintDescriptionCellLength
xlTemplateWorksheet.Cells.Item(2 + i, "E").Value = Mid(strDecriptionLeftOver, 1, intWrapPoint)
strDecriptionLeftOver = Mid(strDecriptionLeftOver, intWrapPoint + 1)
Else
xlTemplateWorksheet.Cells.Item(2 + i, "E").Value = strDecriptionLeftOver
strDecriptionLeftOver = ""
End If
xlTemplateWorksheet.Cells.Item(2 + i, "E").RowHeight = sngRowHeight
Loop
'Start the first item on the second sheet
RS_Detail.MoveNext
intPRSeq = intPRSeq + 1 ''MTMT042705
Do While Not RS_Detail.EOF
i = i + 1
If 2 + i > 500 Then
MsgBox "There are too many items on this PR. Please delete some items and try again.", vbCritical, "NAC Enterprise System"
Exit Do
End If
xlTemplateWorksheet.Cells.Item(2 + i, "A").Value = RS_Detail("Quantity").Value
xlTemplateWorksheet.Cells.Item(2 + i, "B").Value = RS_Detail("UnitofMeasure").Value
If gudtPR_RFQList.FormType = 2 Then 'Blanket
xlTemplateWorksheet.Cells.Item(2 + i, "D").Value = RS_Detail("CommonCode")
End If
'Bookmark MT 042705
''************************************************
'Get the sequence number if spotbuy
If gudtPR_RFQList.FormType = 1 Then ' Spot Buy
xlTemplateWorksheet.Cells.Item(2 + i, "C").Value = intPRSeq
End If
''************************************************
strTmp = gstrGetTotalDescription(RS_Item, RS_Detail)
''************************************************
''MT 042705 begin
gstrBlanketReleaseClause3405 = gstrBlanketReleaseClause3405 & RS_Detail("CommonCode") & " - " & strTmp & " "
''MT 042705 end
''************************************************
''' strRefPRCandSeq = ""
''' If RS_Item("PRType") = "INCREASE" Or RS_Item("PRType") = "DECREASE" Or RS_Item("PRType") = "CANCELLATION" Then
''' strRefPRCandSeq = "Reference PR: " & RS_Detail("ReferencePRC") & "-" & RS_Detail("ReferenceSequenceNumber")
''' End If
''' If gudtPR_RFQList.FormType = 1 Then
''' If gudtPR_RFQList.SpecialRequest = 0 Then
''' strTmp = strProgram & "," & RS_Detail("ProjectId").Value & "," & RS_Detail("CommodityDescription") & ", " & strItemNumber & ", Initial needs date:" & RS_Detail("InitialNeedsDate") & ", Inital needs qty:" & RS_Detail("InitialNeedsQuantity").Value & ", PR Type: " & RS_Item("PRType").Value & "." & RS_Detail("Description") & " " & strRefPRCandSeq & ", Expenditure Cat.: " & RS_Detail("ExpenditureCategory")
''' Else
''' strTmp = strProgram & "," & RS_Detail("CommodityDescription") & ", " & strItemNumber & ", Initial needs date:" & RS_Detail("InitialNeedsDate") & ", Inital needs qty:" & RS_Detail("InitialNeedsQuantity").Value & ", PR Type: " & RS_Item("PRType").Value & "." & RS_Detail("Description") & " " & strRefPRCandSeq & ", Expenditure Cat.: " & RS_Detail("ExpenditureCategory")
''' End If
''' Else
''' If gudtPR_RFQList.SpecialRequest = 0 Then
''' strTmp = "Blanket order release clause: " & RS_Detail("BlanketOrderReleaseClause") & " " & strProgram & "," & RS_Detail("ProjectId").Value & ", " & RS_Detail("CommodityDescription") & ", " & strItemNumber & ", Initial needs date:" & RS_Detail("InitialNeedsDate") & ", Inital needs qty:" & RS_Detail("InitialNeedsQuantity").Value & ", PR Type: " & RS_Item("PRType").Value & ". " & strRefPRCandSeq & ", Expenditure Cat.: " & RS_Detail("ExpenditureCategory")
''' Else
''' strTmp = "Blanket order release clause: " & RS_Detail("BlanketOrderReleaseClause") & " " & strProgram & ", " & RS_Detail("CommodityDescription") & ", " & strItemNumber & ", Initial needs date:" & RS_Detail("InitialNeedsDate") & ", Inital needs qty:" & RS_Detail("InitialNeedsQuantity").Value & ", PR Type: " & RS_Item("PRType").Value & ". " & strRefPRCandSeq & ", Expenditure Cat.: " & RS_Detail("ExpenditureCategory")
''' End If
''' End If
xlTemplateWorksheet.Cells.Item(2 + i, "I").NumberFormat = "0.0000"
xlTemplateWorksheet.Cells.Item(2 + i, "I").Value = Format(RS_Detail("UnitCost").Value, "0.0000")
strDecriptionLeftOver = strTmp
Do While strDecriptionLeftOver <> ""
If Len(strDecriptionLeftOver) > cintDescriptionCellLength Then
intWrapPoint = cintDescriptionCellLength
For j = cintDescriptionCellLength + 1 To 2 Step -1
intAsciCode = Asc(Mid(strDecriptionLeftOver, j, 1))
If (intAsciCode < 97 Or intAsciCode > 122) And (intAsciCode < 65 Or intAsciCode > 90) And (intAsciCode < 48 Or intAsciCode > 57) Then
intWrapPoint = j
Exit For
End If
Next j
If intWrapPoint = 2 Or intWrapPoint = cintDescriptionCellLength + 1 Then intWrapPoint = cintDescriptionCellLength
xlTemplateWorksheet.Cells.Item(2 + i, "E").Value = Mid(strDecriptionLeftOver, 1, intWrapPoint)
xlTemplateWorksheet.Cells.Item(2 + i, "E").RowHeight = sngRowHeight
strDecriptionLeftOver = Mid(strDecriptionLeftOver, intWrapPoint + 1)
i = i + 1
If i + 2 > 500 Then
MsgBox "There are too many items on this PR. Please delete some items and try again.", vbCritical, "NAC Enterprise System"
GoTo FINISH
End If
Else
xlTemplateWorksheet.Cells.Item(2 + i, "E").Value = strDecriptionLeftOver
xlTemplateWorksheet.Cells.Item(2 + i, "E").RowHeight = sngRowHeight
strDecriptionLeftOver = ""
End If
Loop
RS_Detail.MoveNext
intPRSeq = intPRSeq + 1 ''MTMT042705
Loop
'Figure out number of printed pages for the second sheet.
objWorkBook.Application.WindowState = xlMinimized
objWorkBook.Application.Visible = True
objWorkBook.Parent.Windows(1).Visible = True
objWorkBook.Parent.Windows(1).View = xlPageBreakPreview
DoEvents
gintNumOfPages4Sheet2 = xlTemplateWorksheet.HPageBreaks.Count + 1
objWorkBook.Parent.Windows(1).View = xlNormalView
FINISH:
Set xlTemplateWorksheet = objWorkBook.Worksheets(gcstrPRSheet1)
xlTemplateWorksheet.Cells.Item(32, "Y").Value = 2
'Clear the page number stuff
xlTemplateWorksheet.Cells.Item(35, "AW").Value = ""
xlTemplateWorksheet.Cells.Item(35, "AY").Value = ""
xlTemplateWorksheet.Cells.Item(35, "BA").Value = ""
xlTemplateWorksheet.Cells.Item(35, "BB").Value = ""
'Comments to buyer
If gudtPR_RFQList.FormType = 1 Then
xlTemplateWorksheet.Cells.Item(33, "AI").Value = RS_Item("CommentsToBuyer").Value
Else ''MTMT 042505
xlTemplateWorksheet.Range("AI33").Value = gstrBlanketReleaseClause3405
End If
If Not IsNull(rs("DailyOpsIssueCategory").Value) Then
xlTemplateWorksheet.Cells.Item(33, "AI").Value = xlTemplateWorksheet.Cells.Item(33, "AI").Value & " " & rs("DailyOpsIssueCategory").Value
Else
xlTemplateWorksheet.Cells.Item(33, "AI").Value = xlTemplateWorksheet.Cells.Item(33, "AI").Value
End If
''MTMT 042505
'Buyer code
xlTemplateWorksheet.Cells.Item(34, "AB").Value = RS_Item("BuyerCode")
'Buyer Name
xlTemplateWorksheet.Cells.Item(35, "AB").Value = RS_Item("BuyerName")
rs.Close
RS_Item.Close
RS_Detail.Close
fblnMapPRData2Form = True
Exit Function
ERRHD:
MsgBox Err.Description
End Function
Dim xlTemplateWorksheet As Excel.Worksheet
xlTemplateWorksheet.select
I get an Access error box that says: Automation Error, The server threw an exception. Code for the function is below.
What the heck does that mean? If anyone can assist, it would be greatly appreciated. I've never even used MS Access 2007 - not even once yet! Please help!
Additionally, does the holding of the shift button now not work to bring up the database window? We set the switchboard to come up for our users so they can't see the database objects, now we are having a heck of a time too!
Thank you, Tina
Private Function fblnMapPRData2Form(objWorkBook As Excel.Workbook) As Boolean
Dim xlTemplateWorksheet As Excel.Worksheet
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim RS_Item As DAO.Recordset
Dim RS_Detail As DAO.Recordset
Dim sngTotalPage1Cost As Single
Dim sngTotalPage2Cost As Single
Dim i As Long
Dim j As Long
Dim strTmp As String
Dim datMaterialRequired As Date
Dim strFirstName As String
Dim strLastName As String
Dim strName As String
Dim strPRType As String
Dim strDecriptionLeftOver As String
Dim intWrapPoint As Integer
Dim intAsciCode As Integer
Dim sngRowHeight As Single
Dim intPRSeq As Integer ''Order of items on PR used for spotbuy to identify items MTMT 042705
Const cintDescriptionCellLength As Integer = 53
fblnMapPRData2Form = False
On Error GoTo ERRHD
gstrBlanketReleaseClause3405 = ""
gblnPRPage2Used = False
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT * FROM Tbl_PRRFQList WHERE [ID]= " & gudtPR_RFQList.Id)
If gudtPR_RFQList.FormType = 1 Then
Set RS_Item = db.OpenRecordset("SELECT * FROM Tbl_PRSpotBuy WHERE [ID]= " & gudtPR_RFQList.Id)
Else
Set RS_Item = db.OpenRecordset("SELECT * FROM Tbl_PRBlanket WHERE [ID]= " & gudtPR_RFQList.Id)
End If
rs.MoveFirst 'There must be one and only one record
RS_Item.MoveFirst 'There must be one and only one record
Set xlTemplateWorksheet = objWorkBook.Worksheets(gcstrPRSheet1)
xlTemplateWorksheet.Select
DoEvents
'Date material required
Set RS_Detail = db.OpenRecordset("SELECT * FROM Tbl_PRItemDetail WHERE [ID]= " & gudtPR_RFQList.Id & " AND ISDATE([DateRequiredComplete]) ORDER BY CDATE([DateRequiredComplete]) DESC")
If RS_Detail.RecordCount > 0 Then
RS_Detail.MoveFirst 'Get the lasted data
If Not IsNull(RS_Detail("DateRequiredComplete").Value) Then
datMaterialRequired = RS_Detail("DateRequiredComplete").Value
xlTemplateWorksheet.Cells.Item(3, "V").Value = datMaterialRequired
End If
End If
'Select PR TYPE:
strPRType = Trim(RS_Item("PRType"))
Select Case strPRType:
Case "NEW", "ENG CHG", "RE-BUY", "RE-USE"
If gudtPR_RFQList.FormType = 1 Then
xlTemplateWorksheet.Cells.Item(2, "F").Value = 3
Else
xlTemplateWorksheet.Cells.Item(2, "F").Value = 2
End If
Case "INCREASE", "DECREASE", "CANCELLATION"
If gudtPR_RFQList.FormType = 1 Then
xlTemplateWorksheet.Cells.Item(2, "F").Value = 5
Else
xlTemplateWorksheet.Cells.Item(2, "F").Value = 6
End If
'' Case "CANCELLATION"
'' xlTemplateWorksheet.Cells.Item(2, "F").Value = 8
Case Else
MsgBox "Unknown PR Type"
xlTemplateWorksheet.Cells.Item(2, "F").Value = 1
End Select
'' 'PR Number, extracing the letter part and the number part
'' xlTemplateWorksheet.Cells.Item(1, "AN").Text = gudtPR_RFQList.PRNumber
'Olimpic Location Code:
xlTemplateWorksheet.Cells.Item(2, "AY").Value = 4
'Ship to Code
xlTemplateWorksheet.Cells.Item(9, "U").Value = 39
Set RS_Detail = db.OpenRecordset("SELECT * FROM Tbl_PRItemDetail WHERE [ID]= " & gudtPR_RFQList.Id & " ORDER BY [AutoSequence] ASC")
RS_Detail.MoveFirst 'There must be one and only one record
'Reference PO
xlTemplateWorksheet.Cells.Item(1, "R").Value = RS_Detail("ReferencePO").Value
'Blanket order number
If gudtPR_RFQList.FormType = 2 Then
xlTemplateWorksheet.Cells.Item(2, "S").Value = RS_Item("BlanketOrderNumber").Value
End If
'Date PO required
'xlTemplateWorksheet.Cells.Item(3, "AD").Value = "ASAP"
'Requestor info
strName = Trim(rs("RequestorName").Value)
Call gsubGetFirst_LastNames(strName, strFirstName, strLastName)
xlTemplateWorksheet.Cells.Item(4, "G").Value = strFirstName
xlTemplateWorksheet.Cells.Item(5, "G").Value = strLastName
xlTemplateWorksheet.Cells.Item(6, "G").Value = rs("MailCode").Value
xlTemplateWorksheet.Cells.Item(7, "G").Value = rs("PhoneNumber").Value
xlTemplateWorksheet.Cells.Item(8, "G").Value = rs("Email").Value
xlTemplateWorksheet.Cells.Item(9, "G").Value = rs("FaxNumber").Value
xlTemplateWorksheet.Cells.Item(10, "G").Value = rs("Pager").Value
'Approver Info
strName = gudtApprovalOptions.strapprover
Call gsubGetFirst_LastNames(strName, strFirstName, strLastName)
xlTemplateWorksheet.Cells.Item(33, "B").Value = strFirstName & " " & strLastName
'Added by MTMT 042605
xlTemplateWorksheet.Range("E11").Value = 2 ''Default it to NO 'Capital field
'Added by MTMT 042605
'Spot buy or not
If gudtPR_RFQList.FormType = 1 Then
xlTemplateWorksheet.Cells.Item(11, "H").Value = "x"
xlTemplateWorksheet.Cells.Item(11, "H").Font.Size = 16
xlTemplateWorksheet.Cells.Item(11, "H").Font.Bold = True
xlTemplateWorksheet.Cells.Item(11, "H").VerticalAlignment = xlCenter
Else
xlTemplateWorksheet.Cells.Item(11, "M").Value = "x"
xlTemplateWorksheet.Cells.Item(11, "M").Font.Size = 16
xlTemplateWorksheet.Cells.Item(11, "M").Font.Bold = True
xlTemplateWorksheet.Cells.Item(11, "M").VerticalAlignment = xlCenter
End If
'Part supplier info
xlTemplateWorksheet.Cells.Item(5, "R").Value = "TBD"
'No hazardous
xlTemplateWorksheet.Cells.Item(5, "Y").Value = 3
'Tax Code
xlTemplateWorksheet.Cells.Item(5, "AN").Value = 4
'Supplier info
If gudtPR_RFQList.FormType = 1 Then
If RS_Item("SuggestedSupplier").Value = "(TBD)" Then
xlTemplateWorksheet.Cells.Item(7, "AB").Value = "TBD"
Else
xlTemplateWorksheet.Cells.Item(7, "AB").Value = RS_Item("SuggestedSupplier").Value
End If
Else
xlTemplateWorksheet.Cells.Item(7, "AB").Value = RS_Item("BlanketSupplier").Value
End If
xlTemplateWorksheet.Cells.Item(5, "AZ").Value = "'" & Format(RS_Item("DunsNumber").Value, "000000000")
''MTMT 042705 populate program name in additional desc field
xlTemplateWorksheet.Range("AK3").Value = gstrProgram
'Detailed items
RS_Detail.MoveFirst
i = 0
intPRSeq = 1
gintNumOfPages4Sheet1 = 1 'Now always
Do While Not RS_Detail.EOF
i = i + 1
If i > 10 Then
GoTo PAGE2
ElseIf i > 1 And i <= 10 Then
RS_Detail.MoveNext
intPRSeq = intPRSeq + 1 ''MTMT 042705
If RS_Detail.EOF Then GoTo FINISH
End If
xlTemplateWorksheet.Cells.Item(19 + i, "A").Value = RS_Detail("Quantity").Value
xlTemplateWorksheet.Cells.Item(19 + i, "C").Value = RS_Detail("UnitofMeasure").Value
If gudtPR_RFQList.FormType = 2 Then 'Blanket
xlTemplateWorksheet.Cells.Item(19 + i, "J").Value = RS_Detail("CommonCode")
End If
'Bookmark MT 042705
''************************************************
'Get the sequence number if spotbuy
If gudtPR_RFQList.FormType = 1 Then ' Spot Buy
xlTemplateWorksheet.Cells.Item(19 + i, "F").Value = intPRSeq
End If
''************************************************
strTmp = gstrGetTotalDescription(RS_Item, RS_Detail)
''************************************************
''MT 042705 begin
gstrBlanketReleaseClause3405 = gstrBlanketReleaseClause3405 & RS_Detail("CommonCode") & " - " & strTmp & " "
''MT 042705 end
''************************************************
xlTemplateWorksheet.Cells.Item(19 + i, "AZ").NumberFormat = "0.0000"
xlTemplateWorksheet.Cells.Item(19 + i, "AZ").Value = Format(RS_Detail("UnitCost").Value, "0.0000")
strDecriptionLeftOver = strTmp
Do While strDecriptionLeftOver <> ""
If Len(strDecriptionLeftOver) > cintDescriptionCellLength Then
intWrapPoint = cintDescriptionCellLength
For j = cintDescriptionCellLength + 1 To 2 Step -1
intAsciCode = Asc(Mid(strDecriptionLeftOver, j, 1))
If (intAsciCode < 97 Or intAsciCode > 122) And (intAsciCode < 65 Or intAsciCode > 90) And (intAsciCode < 48 Or intAsciCode > 57) Then
intWrapPoint = j
Exit For
End If
Next j
If intWrapPoint = 2 Or intWrapPoint = cintDescriptionCellLength + 1 Then intWrapPoint = cintDescriptionCellLength
xlTemplateWorksheet.Cells.Item(19 + i, "O").Value = Mid(strDecriptionLeftOver, 1, intWrapPoint)
strDecriptionLeftOver = Mid(strDecriptionLeftOver, intWrapPoint + 1)
i = i + 1
If i > 10 Then GoTo PAGE2
Else
xlTemplateWorksheet.Cells.Item(19 + i, "O").Value = strDecriptionLeftOver
strDecriptionLeftOver = ""
End If
Loop
Loop
GoTo FINISH
PAGE2:
gblnPRPage2Used = True
Set xlTemplateWorksheet = objWorkBook.Worksheets(gcstrPRSheet2)
sngRowHeight = xlTemplateWorksheet.Cells.Range("A3:A3").RowHeight
xlTemplateWorksheet.Cells.Range("A3:A500").RowHeight = 0
'Finish up the left over description from sheet 1 if any.
i = 0
Do While strDecriptionLeftOver <> ""
i = i + 1
If i + 2 > 500 Then
MsgBox "There are too many items on this PR. Please delete some items and try again.", vbCritical, "NAC Enterprise System"
GoTo FINISH
End If
If Len(strDecriptionLeftOver) > cintDescriptionCellLength Then
intWrapPoint = cintDescriptionCellLength
For j = cintDescriptionCellLength + 1 To 2 Step -1
intAsciCode = Asc(Mid(strDecriptionLeftOver, j, 1))
If (intAsciCode < 97 Or intAsciCode > 122) And (intAsciCode < 65 Or intAsciCode > 90) And (intAsciCode < 48 Or intAsciCode > 57) Then
intWrapPoint = j
Exit For
End If
Next j
If intWrapPoint = 2 Or intWrapPoint = cintDescriptionCellLength + 1 Then intWrapPoint = cintDescriptionCellLength
xlTemplateWorksheet.Cells.Item(2 + i, "E").Value = Mid(strDecriptionLeftOver, 1, intWrapPoint)
strDecriptionLeftOver = Mid(strDecriptionLeftOver, intWrapPoint + 1)
Else
xlTemplateWorksheet.Cells.Item(2 + i, "E").Value = strDecriptionLeftOver
strDecriptionLeftOver = ""
End If
xlTemplateWorksheet.Cells.Item(2 + i, "E").RowHeight = sngRowHeight
Loop
'Start the first item on the second sheet
RS_Detail.MoveNext
intPRSeq = intPRSeq + 1 ''MTMT042705
Do While Not RS_Detail.EOF
i = i + 1
If 2 + i > 500 Then
MsgBox "There are too many items on this PR. Please delete some items and try again.", vbCritical, "NAC Enterprise System"
Exit Do
End If
xlTemplateWorksheet.Cells.Item(2 + i, "A").Value = RS_Detail("Quantity").Value
xlTemplateWorksheet.Cells.Item(2 + i, "B").Value = RS_Detail("UnitofMeasure").Value
If gudtPR_RFQList.FormType = 2 Then 'Blanket
xlTemplateWorksheet.Cells.Item(2 + i, "D").Value = RS_Detail("CommonCode")
End If
'Bookmark MT 042705
''************************************************
'Get the sequence number if spotbuy
If gudtPR_RFQList.FormType = 1 Then ' Spot Buy
xlTemplateWorksheet.Cells.Item(2 + i, "C").Value = intPRSeq
End If
''************************************************
strTmp = gstrGetTotalDescription(RS_Item, RS_Detail)
''************************************************
''MT 042705 begin
gstrBlanketReleaseClause3405 = gstrBlanketReleaseClause3405 & RS_Detail("CommonCode") & " - " & strTmp & " "
''MT 042705 end
''************************************************
''' strRefPRCandSeq = ""
''' If RS_Item("PRType") = "INCREASE" Or RS_Item("PRType") = "DECREASE" Or RS_Item("PRType") = "CANCELLATION" Then
''' strRefPRCandSeq = "Reference PR: " & RS_Detail("ReferencePRC") & "-" & RS_Detail("ReferenceSequenceNumber")
''' End If
''' If gudtPR_RFQList.FormType = 1 Then
''' If gudtPR_RFQList.SpecialRequest = 0 Then
''' strTmp = strProgram & "," & RS_Detail("ProjectId").Value & "," & RS_Detail("CommodityDescription") & ", " & strItemNumber & ", Initial needs date:" & RS_Detail("InitialNeedsDate") & ", Inital needs qty:" & RS_Detail("InitialNeedsQuantity").Value & ", PR Type: " & RS_Item("PRType").Value & "." & RS_Detail("Description") & " " & strRefPRCandSeq & ", Expenditure Cat.: " & RS_Detail("ExpenditureCategory")
''' Else
''' strTmp = strProgram & "," & RS_Detail("CommodityDescription") & ", " & strItemNumber & ", Initial needs date:" & RS_Detail("InitialNeedsDate") & ", Inital needs qty:" & RS_Detail("InitialNeedsQuantity").Value & ", PR Type: " & RS_Item("PRType").Value & "." & RS_Detail("Description") & " " & strRefPRCandSeq & ", Expenditure Cat.: " & RS_Detail("ExpenditureCategory")
''' End If
''' Else
''' If gudtPR_RFQList.SpecialRequest = 0 Then
''' strTmp = "Blanket order release clause: " & RS_Detail("BlanketOrderReleaseClause") & " " & strProgram & "," & RS_Detail("ProjectId").Value & ", " & RS_Detail("CommodityDescription") & ", " & strItemNumber & ", Initial needs date:" & RS_Detail("InitialNeedsDate") & ", Inital needs qty:" & RS_Detail("InitialNeedsQuantity").Value & ", PR Type: " & RS_Item("PRType").Value & ". " & strRefPRCandSeq & ", Expenditure Cat.: " & RS_Detail("ExpenditureCategory")
''' Else
''' strTmp = "Blanket order release clause: " & RS_Detail("BlanketOrderReleaseClause") & " " & strProgram & ", " & RS_Detail("CommodityDescription") & ", " & strItemNumber & ", Initial needs date:" & RS_Detail("InitialNeedsDate") & ", Inital needs qty:" & RS_Detail("InitialNeedsQuantity").Value & ", PR Type: " & RS_Item("PRType").Value & ". " & strRefPRCandSeq & ", Expenditure Cat.: " & RS_Detail("ExpenditureCategory")
''' End If
''' End If
xlTemplateWorksheet.Cells.Item(2 + i, "I").NumberFormat = "0.0000"
xlTemplateWorksheet.Cells.Item(2 + i, "I").Value = Format(RS_Detail("UnitCost").Value, "0.0000")
strDecriptionLeftOver = strTmp
Do While strDecriptionLeftOver <> ""
If Len(strDecriptionLeftOver) > cintDescriptionCellLength Then
intWrapPoint = cintDescriptionCellLength
For j = cintDescriptionCellLength + 1 To 2 Step -1
intAsciCode = Asc(Mid(strDecriptionLeftOver, j, 1))
If (intAsciCode < 97 Or intAsciCode > 122) And (intAsciCode < 65 Or intAsciCode > 90) And (intAsciCode < 48 Or intAsciCode > 57) Then
intWrapPoint = j
Exit For
End If
Next j
If intWrapPoint = 2 Or intWrapPoint = cintDescriptionCellLength + 1 Then intWrapPoint = cintDescriptionCellLength
xlTemplateWorksheet.Cells.Item(2 + i, "E").Value = Mid(strDecriptionLeftOver, 1, intWrapPoint)
xlTemplateWorksheet.Cells.Item(2 + i, "E").RowHeight = sngRowHeight
strDecriptionLeftOver = Mid(strDecriptionLeftOver, intWrapPoint + 1)
i = i + 1
If i + 2 > 500 Then
MsgBox "There are too many items on this PR. Please delete some items and try again.", vbCritical, "NAC Enterprise System"
GoTo FINISH
End If
Else
xlTemplateWorksheet.Cells.Item(2 + i, "E").Value = strDecriptionLeftOver
xlTemplateWorksheet.Cells.Item(2 + i, "E").RowHeight = sngRowHeight
strDecriptionLeftOver = ""
End If
Loop
RS_Detail.MoveNext
intPRSeq = intPRSeq + 1 ''MTMT042705
Loop
'Figure out number of printed pages for the second sheet.
objWorkBook.Application.WindowState = xlMinimized
objWorkBook.Application.Visible = True
objWorkBook.Parent.Windows(1).Visible = True
objWorkBook.Parent.Windows(1).View = xlPageBreakPreview
DoEvents
gintNumOfPages4Sheet2 = xlTemplateWorksheet.HPageBreaks.Count + 1
objWorkBook.Parent.Windows(1).View = xlNormalView
FINISH:
Set xlTemplateWorksheet = objWorkBook.Worksheets(gcstrPRSheet1)
xlTemplateWorksheet.Cells.Item(32, "Y").Value = 2
'Clear the page number stuff
xlTemplateWorksheet.Cells.Item(35, "AW").Value = ""
xlTemplateWorksheet.Cells.Item(35, "AY").Value = ""
xlTemplateWorksheet.Cells.Item(35, "BA").Value = ""
xlTemplateWorksheet.Cells.Item(35, "BB").Value = ""
'Comments to buyer
If gudtPR_RFQList.FormType = 1 Then
xlTemplateWorksheet.Cells.Item(33, "AI").Value = RS_Item("CommentsToBuyer").Value
Else ''MTMT 042505
xlTemplateWorksheet.Range("AI33").Value = gstrBlanketReleaseClause3405
End If
If Not IsNull(rs("DailyOpsIssueCategory").Value) Then
xlTemplateWorksheet.Cells.Item(33, "AI").Value = xlTemplateWorksheet.Cells.Item(33, "AI").Value & " " & rs("DailyOpsIssueCategory").Value
Else
xlTemplateWorksheet.Cells.Item(33, "AI").Value = xlTemplateWorksheet.Cells.Item(33, "AI").Value
End If
''MTMT 042505
'Buyer code
xlTemplateWorksheet.Cells.Item(34, "AB").Value = RS_Item("BuyerCode")
'Buyer Name
xlTemplateWorksheet.Cells.Item(35, "AB").Value = RS_Item("BuyerName")
rs.Close
RS_Item.Close
RS_Detail.Close
fblnMapPRData2Form = True
Exit Function
ERRHD:
MsgBox Err.Description
End Function
