K
Keith Wilby
I'm using this VBA code snippet in an MS Access form to manipulate and Excel
workbook. The code works out the current week number in the format "yww" (eg
"824") and uses that to test the workbook for a sheet with that name. If it
finds one it uses it, if it doesn't it looks for the previous week's and
copies and renames it.
The code intermittently fails at the line with the asterisks. The error I
get is "Application-defined or object-defined error". The funny thing is
that it worked perfectly until I introduced an option group on my MS Access
form ("Me.ogrPeriod") to let the user choose "This Week" or "Last Week" and
the error seems to be happening at random intervals. A long shot but, does
anyone know what's going on?
Many thanks.
Keith.
'Open the Excel spreadsheet
Set objXL = New Excel.Application
Set objWkb = objXL.Workbooks.Open(strFilePath)
objXL.Visible = False
'Copy the previous week's sheet if there is not one for this week in the
workbook
strWeekNo = IIf(Len(Format(Date, "ww")) = 1, "0" & Format(Date, "ww"),
Format(Date, "ww"))
strWeekNo = Right(Date, 1) & strWeekNo
'Take into account the reporting period
strWeekNo = strWeekNo - Me.ogrPeriod
If libSheetExists(objWkb, objSht, strWeekNo) = False Then
Dim strPreviousWeek As String
strPreviousWeek = strWeekNo - 1
'Check whether there's a sheet for the previous week. If there isn't
then create a new, unformatted one.
If libSheetExists(objWkb, objSht, strPreviousWeek) = False Then
MsgBox "No suitable sheets were found in the selected workbook. A
new, unformatted sheet will be created.", vbExclamation, "Sheet not found"
Call CreateNew
GoTo ResumeNew
End If
Set objSht = objWkb.Worksheets(strPreviousWeek) 'Select the previous
week's sheet
objSht.Select
objSht.Copy After:=Worksheets(strPreviousWeek) ' ***********************
code fails here
strPreviousWeek = strPreviousWeek & " (2)" 'The copied sheet bears the
same name as the original plus " (2)"
Set objSht = objWkb.Worksheets(strPreviousWeek) 'Select the copied sheet
objSht.Name = strWeekNo 'Rename the copied sheet
'DO STUFF
'Save the workbook
objXL.ActiveWorkbook.Save
'Give the user the option to view the workbook
If MsgBox("Data exported. Do you want to view the spreadsheet?", vbYesNo,
"Data exported") = vbNo Then
objXL.Quit
Else
objSht.Activate
objXL.Visible = True
End If
'Tidy Up
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing
workbook. The code works out the current week number in the format "yww" (eg
"824") and uses that to test the workbook for a sheet with that name. If it
finds one it uses it, if it doesn't it looks for the previous week's and
copies and renames it.
The code intermittently fails at the line with the asterisks. The error I
get is "Application-defined or object-defined error". The funny thing is
that it worked perfectly until I introduced an option group on my MS Access
form ("Me.ogrPeriod") to let the user choose "This Week" or "Last Week" and
the error seems to be happening at random intervals. A long shot but, does
anyone know what's going on?
Many thanks.
Keith.
'Open the Excel spreadsheet
Set objXL = New Excel.Application
Set objWkb = objXL.Workbooks.Open(strFilePath)
objXL.Visible = False
'Copy the previous week's sheet if there is not one for this week in the
workbook
strWeekNo = IIf(Len(Format(Date, "ww")) = 1, "0" & Format(Date, "ww"),
Format(Date, "ww"))
strWeekNo = Right(Date, 1) & strWeekNo
'Take into account the reporting period
strWeekNo = strWeekNo - Me.ogrPeriod
If libSheetExists(objWkb, objSht, strWeekNo) = False Then
Dim strPreviousWeek As String
strPreviousWeek = strWeekNo - 1
'Check whether there's a sheet for the previous week. If there isn't
then create a new, unformatted one.
If libSheetExists(objWkb, objSht, strPreviousWeek) = False Then
MsgBox "No suitable sheets were found in the selected workbook. A
new, unformatted sheet will be created.", vbExclamation, "Sheet not found"
Call CreateNew
GoTo ResumeNew
End If
Set objSht = objWkb.Worksheets(strPreviousWeek) 'Select the previous
week's sheet
objSht.Select
objSht.Copy After:=Worksheets(strPreviousWeek) ' ***********************
code fails here
strPreviousWeek = strPreviousWeek & " (2)" 'The copied sheet bears the
same name as the original plus " (2)"
Set objSht = objWkb.Worksheets(strPreviousWeek) 'Select the copied sheet
objSht.Name = strWeekNo 'Rename the copied sheet
'DO STUFF
'Save the workbook
objXL.ActiveWorkbook.Save
'Give the user the option to view the workbook
If MsgBox("Data exported. Do you want to view the spreadsheet?", vbYesNo,
"Data exported") = vbNo Then
objXL.Quit
Else
objSht.Activate
objXL.Visible = True
End If
'Tidy Up
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing