Greetings,
I'm working on a transmittals Database that will transfer the desired
info (via TID number) from 2 tables into a excel form, (a transmittal template). The form populates and then a error msgbox
pops up:
"Either BOF or EOF is true, or the current record has been deleted, requested operation requires a current record"
What is this error and how do I fix this?
Also, it seems to take clicking the command button twice for the excel form to spring open. I'n not sure what is causing this. I may need to just re-boot or do a utility/compact and repair.
Another Item is how do I get it to open or save as another file name?
example: "projNo-company-date-TIDno", it would look like this: "11256-Englobal-040206-53.xls"
Here is my code:
Private Sub cmdNewtrans_Click()
On Error GoTo CmdRepErr
Dim xlAdd As Integer
Dim xlApp As Excel.Application
Dim xlDoc As Excel.Worksheet
Dim FileStr As String
Dim Rst2 As ADODB.Recordset
' Dim DocPname As Integer
' Dim DocCname As String
' Dim DocNname As Integer
Me.Requery
Me.Refresh
'DoCmd.DoMenuItem(acFormBar,acRecordsMenu,acSaveRe cord, ,acMenuVer70)
' TransCmd = "XL"
Set Cnx = New ADODB.Connection
Set Rst = New ADODB.Recordset
Set Rst2 = New ADODB.Recordset
Set fso = CreateObject("Scripting.FileSystemObject") 'creates an activeX object
Cnx.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Access.CurrentDb.Name & ";Persist Security Info=False"
Cnx.Open
If Rst.State = 1 Then Rst.Close
'opens first Record set from tbltransmittals table
Rst.Open "select * from tblTransmittals where TID = " & [TIDNo], Cnx, adOpenKeyset, adLockOptimistic
'quotation marks are required for it to be red as a string
'Opens next set of records from tbltransdwgs
Rst2.Open "select * from tblTransdwgs where [TID] = " & [TIDNo], Cnx, adOpenKeyset, adLockOptimistic
Set xlApp = New Excel.Application 'set the application object to a new excel session
xlApp.Workbooks.Open fso.getparentfoldername(Access.CurrentDb.Name) & "\TRANS_template.xls" 'open the template xls file
xlApp.Visible = True 'bring it up on screen
Set xlDoc = xlApp.ActiveSheet 'set the document object to the template xls we just opened
xlDoc.PageSetup.CenterHorizontally = True
xlDoc.PageSetup.CenterVertically = True
'rst.tblTransmittals
xlDoc.Range("AL6").Value = Rst.Fields("ProjTitle")
xlDoc.Range("AL7").Value = Rst.Fields("ProjTitle2")
xlDoc.Range("AL8").Value = Rst.Fields("ProjNo")
xlDoc.Range("AL9").Value = Rst.Fields("ProjEng")
xlDoc.Range("N11").Value = Rst.Fields("TID")
xlDoc.Range("N12").Value = Rst.Fields("TransBy")
xlDoc.Range("N13").Value = Rst.Fields("Date")
'xlDoc.Range("N14").Value = Rst.Fields("Tphone")
xlDoc.Range("AL11").Value = Rst.Fields("Courier")
xlDoc.Range("AL12").Value = Rst.Fields("Copyto")
xlDoc.Range("AL13").Value = Rst.Fields("Company")
xlDoc.Range("AL14").Value = Rst.Fields("CPhone")
xlDoc.Range("AS57").Value = Rst.Fields("signed")
xlDoc.Range("B52").Value = Rst.Fields("Comments")
' DocPname = Rst.Fields("ProjNo")
' DocCname = Rst.Fields("Company")
' DocNname = Rst.Fields("TID")
xlAdd = 16 'sets xladd varible - row 16
'Absolute position is a locator or starting location
'reset this to the first recordset.
Do Until Rst.EOF 'for each record we just opened with the recordset
If Rst.AbsolutePosition > 20 Then Exit Do '?if less than then your last page
If Rst.AbsolutePosition = 1 Then '? do on first record once
Select Case Rst.Fields("Status") '? IF status = true then value = X?
Case "Issued for Approval": xlDoc.Range("C41").Value = "X"
Case "Issued for Construction": xlDoc.Range("C43").Value = "X"
Case "As Requested": xlDoc.Range("C45").Value = "X"
Case "For Review & Comment": xlDoc.Range("C47").Value = "X"
Case "Issued for Bid": xlDoc.Range("C49").Value = "X"
Case "Issed for Estimates Only": xlDoc.Range("X41").Value = "X"
Case "Approved as Noted": xlDoc.Range("X43").Value = "X"
Case "Returned for Corrections": xlDoc.Range("X45").Value = "X"
Case "For Your Use": xlDoc.Range("X47").Value = "X"
Case "Prints Returned from Us": xlDoc.Range("X49").Value = "X"
Case "Resubmit for Approval": xlDoc.Range("AW41").Value = "X"
Case "Return for Distribution": xlDoc.Range("AW43").Value = "X"
Case "Return Corrected Prints": xlDoc.Range("AW45").Value = "X"
Case Else: xlDoc.Range("AW47").Value = "X"
End Select
End If
'This is a part of the 2nd record set Cstr turns into string
xlDoc.Range("A" & CStr(xlAdd + Rst2.AbsolutePosition)).Value = Rst2.Fields("Copies") 'basically, the range property of the document object is used
xlDoc.Range("F" & CStr(xlAdd + Rst2.AbsolutePosition)).Value = Rst2.Fields("DwgNo") 'to get or set the values of each cell. Notice how the range
xlDoc.Range("U" & CStr(xlAdd + Rst2.AbsolutePosition)).Value = Trim(Rst2.Fields("Rev")) 'object calls on a certain cell and sets the value
xlDoc.Range("W" & CStr(xlAdd + Rst2.AbsolutePosition)).Value = Trim(Rst2.Fields("FileName")) 'to the corresponding field in the recordset.
xlDoc.Range("AI" & CStr(xlAdd + Rst2.AbsolutePosition)).Value = Rst2.Fields("Media") 'im adding the absolute position of the recordset to 16 because
xlDoc.Range("AN" & CStr(xlAdd + Rst2.AbsolutePosition)).Value = Rst2.Fields("DrawingTitle") 'the first record in the xls template starts at row 17...
' If Rst2.Fields("New") = -1 Then xlDoc.Range("BT" & CStr(xlAdd + Rst2.AbsolutePosition)).Value = "X" 'and the first absoluteposition in the recordset is 1.
' If Rst2.Fields("Revised") = -1 Then xlDoc.Range("BU" & CStr(xlAdd + Rst2.AbsolutePosition)).Value = "X" '1 + 16 = 17 and then the absoluteposition in the recordset will go
' If Rst2.Fields("Unrevised") = -1 Then xlDoc.Range("BV" & CStr(xlAdd + Rst2.AbsolutePosition)).Value = "X" 'up as you execute rst.movenext. So this section of code
' 'fills the ENTIRE xl spreadsheet no matter how many records are being reported.
Rst2.MoveNext 'move to the next record AND increment the absoluteposition value by 1
Loop
Rst.Close 'close recordset object
Rst2.Close
Cnx.Close 'close connection object
FileStr = fso.getparentfoldername(Access.CurrentDb.Name)
' FileStr = fso.getparentfoldername(Access.CurrentDb.Name) & "DocPname" & "-" & "DocCname" & Format(Date, "mmddyy") & "-" & "DocNname"
'xlDoc.SaveAs FileStr
Exit Sub
CmdRepErr:
MsgBox Err.Description
Resume
End Sub
Thanks
John Paul
Access to Excel - BOF or EOF error
