Excel macro running from Access is un-stable

[Pacers02]

Hello. I am having some problems with some excel vba code I am running from
access. The code will work sometimes and will fail sometimes under the exact
same conditions. I have been unable to identify the root cause, however it
is failing at the section where the sheets are deleted. Any help would be
greatly appreciated.

Code:
Sub TestFileCopy()
On Error GoTo ErrorHandler
If msgBox("Would you like to import and prepare prior weeks BIC file?",
vbYesNo, "Import File") = vbYes Then
Dim bicPath As String
Dim fileName As String
Dim savePath As String
Dim dt As String
Dim fs As FileSystemObject
Dim xl As Object

'Set variables
dt = "1-28-2007"
bicPath = "PathName"
fileName = "File Name"

savePath = "PathName"

'Copy over the file
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile bicPath & fileName, savePath

'Open file and prepare it for importing
Set xl = CreateObject("Excel.Application")

xl.Workbooks.Open savePath & fileName
' xl.Visible = True

xl.DisplayAlerts = False

'Determines if this is a shared file. If it is, it converts to a
non-shared file
If xl.Workbooks(fileName).MultiUserEditing Then
xl.Workbooks(fileName).ExclusiveAccess
End If
xl.Workbooks(fileName).Close

' close wb and reopen for debugging
xl.Workbooks.Open savePath & fileName
xl.Visible = True

'If sheet name doesn't = ESN, ANIS, STAT, MEID then it is deleted
xl.Workbooks(fileName).Activate

Dim i As Integer
i = 1

Do
ActiveWorkbook.Worksheets(i).Activate
'ActiveWorkbook.Worksheets(i).Activate
'ActiveSheet.Visible = True
'This section only updates i to the next counter number if the sheet
is not deleted, otherwise it skips the next sheet

If ActiveWorkbook.ActiveSheet.Name <> "ANIS" And ActiveSheet.Name <>
"ESN" And ActiveSheet.Name <> "STAT" And ActiveSheet.Name <> "MEID" Then

ActiveWorkbook.ActiveSheet.Delete
Else
i = i + 1
End If
Loop While i < (Worksheets.Count + 1)
xl.Workbooks(fileName).Save
xl.Workbooks(fileName).Close

xl.DisplayAlerts = True

End If
msgBox "Done"
Exit Sub

ErrorHandler:
msgBox "Error number: " & Err.Number & Chr(10) & Err.Description
End Sub

 

[George Nicholson]

Not sure why your code is failing, but you might try the following
simplification of your loop (no need for counter or Activate...). I added a
check to prevent attempts to delete the only remaining sheet of a workbook.
Maybe that was causing the errors? If not, it would help to know which line
actually breaks.

HTH,

Dim wks as Worksheet
For Each wks in ActiveWorkbook.Worksheets
Select Case wks.Name
Case "ESN", "ANIS", "STAT", "MEID"
' Do Nothing
Case Else
If ActiveWorkbook.Worksheets.Count >1 Then
wks.Delete
End If
End Select
Next wks

 

[Kamil Dursun]

Hi Pacers02,

I suspect that the loop is exceeding the number of worksheets.

You see, when you delete activeworksheet which is worksheets(i), then
worksheets(i+1) becomes worksheets(i) and when you loop to i+1, you skip
worksheets(i) which you should do the operation on. At the end, the number of
worksheets is less than the original worksheets.count and you get an error
message.

I suggest that you try the following:

for i=1 to activeworkbook.worksheets.count

activeworkbook.worksheets(1).delete 'NOT i but 1 (one) - or was it 0? I
don't remember

'when you delete the worksheet(1), next time worksheet(2) becomes
worksheet(1) so you can continue

next i

Good luck
Kamil

 

[Kamil Dursun]

Hi,

After reading your message once more, I suggest the following code:

Dim i as long
Dim n as long
Dim Tst as boolean

n=1

for i=1 to activeworkbook.worksheets.count

Tst = (activeworkbook.worksheets(n).name<>"ANIS") And ...etc.
if Tst then
activeworkbook.worksheets(n).delete
else
n=n+1
end if
next i

This way you cater for the files that you should not be deleting also. Your
code would not crash if all your worksheets have names "ANIS", "MEID" etc.
This is probably why you have difficulties pinpointing the problem.

Kamil

 

[John Spencer]

Delete in reverse order. Start at the highest count worksheet position and
move backwards through the collection.

Dim iLoop as Integer

For iLoop = ActiveWorkBook.WorkSheets.Count -1 to 0 Step -1
Select Case ActiveWorkBook.WorkSheets(iLoop).Name
Case "ESN", "ANIS", "STAT", "MEID"
' Do Nothing
Case Else
ActiveWorkbook.Worksheets(iLoop).Delete
End Select
Next iLoop


--
John Spencer
Access MVP 2002-2005, 2007
Center for Health Program Development and Management
University of Maryland Baltimore County
..

 

[Pacers02]

Thank you all for your help. George's suggestion worked great.... no more
crashing. I didn't try the others, b/c I already used Georges, but I am sure
they would have worked also. Thanks again.