Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

hanging at end of file 1

Status
Not open for further replies.

Delindan

MIS
May 27, 2011
203
US
I am exporting a query from access into individual excel files for each specialist. I'm so close and have been struggling over this last bit. When the routine reaches the last specialist it creates that last file just fine however doesn't save or close it. When I run debug it points to the line Do While RSSpecialist("FS Specialist") = strSpecialistName. So I think it gets to the end of the file and doesn't know what to do. The thing that confuses me is that all the previous files save and close...it's only the last one that hangs up. I'll post the code...any ideas would be appreciated!

Option Compare Database
Option Explicit

Private Sub cmdCreateTemplates_Click()

Dim DB As Database
Dim xlApp As New Excel.Application
Dim RSSpecialist As Recordset
Dim strSpcTemplate As String
Dim strFolder As String
Dim WB As Workbook
Dim strFileName As String
Dim strSheetName As String
Dim introw As Long
Dim strSpecialistName As String


strFolder = Trim(txtFolder)
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
strSpcTemplate = strFolder & "Specialist Entries Table.xlsx"

txtCurrProfile = Null
DoEvents

Set DB = CurrentDb
Set RSSpecialist = DB.OpenRecordset("FS Data", dbOpenSnapshot)

RSSpecialist.MoveFirst
Do While Not RSSpecialist.EOF
strSpecialistName = RSSpecialist("FS Specialist")
strFileName = strFolder & "FS Specialist " & strSpecialistName & ".xlsx"
txtCurrProfile = "Exporting " & strSpecialistName & " ..."
DoEvents

With xlApp
.Visible = False
Set WB = .Workbooks.Open(strSpcTemplate)
.Workbooks(1).SaveAs (strFileName)
End With

xlApp.Worksheets(1).Cells(1, 2) = RSSpecialist("FS Specialist")
introw = 3
Do While RSSpecialist("FS Specialist") = strSpecialistName
xlApp.Worksheets(1).Cells(introw, 1) = RSSpecialist("Breeder")
xlApp.Worksheets(1).Cells(introw, 2) = RSSpecialist("Family")
xlApp.Worksheets(1).Cells(introw, 3) = RSSpecialist("Crop")
xlApp.Worksheets(1).Cells(introw, 4) = RSSpecialist("Sub Crop")
xlApp.Worksheets(1).Cells(introw, 5) = RSSpecialist("Data Year")
xlApp.Worksheets(1).Cells(introw, 6) = RSSpecialist("advcd phs 4")
xlApp.Worksheets(1).Cells(introw, 7) = RSSpecialist("advcd phs 5 advcd comm")
xlApp.Worksheets(1).Cells(introw, 8) = RSSpecialist("advcd phs 5 entered FS at phase 3")
xlApp.Worksheets(1).Cells(introw, 9) = RSSpecialist("advcd phs 5 entered FS at phase 4")
xlApp.Worksheets(1).Cells(introw, 10) = RSSpecialist("moved phs 4 to phs 6")
xlApp.Worksheets(1).Cells(introw, 10) = RSSpecialist("Estimate of new entries")
introw = introw + 1
RSSpecialist.MoveNext
Loop

With xlApp
.Workbooks(1).Save
.Workbooks(1).Close
End With

Loop

xlApp.Quit
RSSpecialist.Close
DB.Close

Set xlApp = Nothing
Set RSSpecialist = Nothing
Set DB = Nothing


txtCurrProfile = "Done!"
DoEvents


End Sub
 
Replace this:
Do While RSSpecialist("FS Specialist") = strSpecialistName
with this:
Do While Not RSSpecialist.EOF And RSSpecialist("FS Specialist") = strSpecialistName

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 
Thanks for the suggestion...I didn't get any errors however it didn't create any files either so I guess it didn't find any data that fit the criteria. Hmmm...
 
Just for the heck of it I replaced the And with an Or in the statement and I got the same error as the initial one.
 
I added
With xlApp
.Workbooks(1).Save
.Workbooks(1).Close
End With

outside the last loop. I thought for sure this would fix it because once it does the RSSpecialist.Movenext and strRSSpecialist no longer equals RSSpecialist(FS Specialist) and it's also at the end of the file, it makes sense it would miss the save and close commands. No luck though. Once it reaches the end of the file, it doesn't save and close that last file and the debug lands at the line
Do While RSSpecialist("FS Specialist") = strSpecialistName

So somehow it is having trouble figuring out what to do when it hits the last record.

 

Did you try:
Code:
...
    introw = introw + 1
    RSSpecialist.MoveNext
[blue]
    If RSSpecialist.EOF Then
        Exit Loop
    End If[/blue]
Loop

Have fun.

---- Andy
 
Thanks so much for the input. As you suggested, the problem was at eof. Once it got to the eof, there was no RSspecialist to compare to and it got stuck in that inner loop.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top