Runtime error 91 ??

[Smigger]

Afternoon,

I'm having a little trouble with the code listed below, in Access 2003 which is opening and editing an existing Excel 2003 workbook.

The section of code works the first time round, however, on the second pass the Runtime error 91 comes to haunt me at the line highlighted in bold below.

The idea of the script is to update a standard customer questionaire (xls file) with some basic details from a database and then attach the now updated personalized excel file and mails it to the user

Sub ControlOutlook()

Dim objOutlook As New Outlook.Application
Dim objEmail As Outlook.MailItem
Dim strLtrContent As String
Dim ExcelApp As New Excel.Application
Dim ExcelFile As New Excel.Workbook
Dim ExcelSheet As New Excel.Worksheet
Dim SheetName As String
Dim rsSmartData As New ADODB.Recordset

rsSmartData.ActiveConnection = CurrentProject.Connection
rsSmartData.Open "SmartData"

'For each record in the Smart Data table send and e-mail

Do While Not rsSmartData.EOF

' mail construct goes here

strLtrContent = "Dear" & " " & rsSmartData("Customer Name") & ":" & vbCrLf & vbCrLf
strLtrContent = strLtrContent & "You have been selected to take part in our customer satisfaction survey, "
strLtrContent = strLtrContent & "Would you please take the time to compelete the attached form. "
strLtrContent = strLtrContent & vbCrLf & vbCrLf & "Please do NOT reply to the sender of this e-mail"
strLtrContent = strLtrContent & vbCrLf & vbCrLf & "Sincerly," & vbCrLf & vbCrLf
strLtrContent = strLtrContent & "Distributed Provisioning"

' This section is designed to open up the standard customer questionnaire
' and save the details per line item within this loop

ExcelApp.Visible = True
Set ExcelFile = ExcelApp.Workbooks.Open("S:\Admin- BF\ESCQ\Questionaire\ECSQ.xls")
Set ExcelSheet = ExcelApp.Worksheets("Answers")

With ExcelSheet

ActiveSheet.Unprotect ("****")

.Range("C2").Value = rsSmartData("Job ref")
.Range("D2").Value = rsSmartData("Unique Job Ref")
.Range("F2").Value = rsSmartData("Catalogue Description")
.Range("G2").Value = rsSmartData("Product Name")

ActiveSheet.Protect ("****")

End With

Excel.Application.DisplayAlerts = False
ExcelFile.Save
ExcelFile.Close True
ExcelApp.Quit

Set ExcelSheet = Nothing
Set ExcelFile = Nothing
Set ExcelApp = Nothing

' Prepares the mail for sending

Set objEmail = objOutlook.CreateItem(olMailItem)
objEmail.Recipients.Add rsSmartData("Recipient ID")
objEmail.Subject = "Order IT Customer Satisfaction Survey. "
objEmail.Body = strLtrContent
objEmail.Attachments.Add ("S:\Admin- BF\ESCQ\Questionaire\ECSQ.xls")

objEmail.Send

rsSmartData.MoveNext

Loop

End Sub

[ADezii]

Afternoon,

I'm having a little trouble with the code listed below, in Access 2003 which is opening and editing an existing Excel 2003 workbook.

The section of code works the first time round, however, on the second pass the Runtime error 91 comes to haunt me at the line highlighted in bold below.

The idea of the script is to update a standard customer questionaire (xls file) with some basic details from a database and then attach the now updated personalized excel file and mails it to the user

Sub ControlOutlook()

Dim objOutlook As New Outlook.Application
Dim objEmail As Outlook.MailItem
Dim strLtrContent As String
Dim ExcelApp As New Excel.Application
Dim ExcelFile As New Excel.Workbook
Dim ExcelSheet As New Excel.Worksheet
Dim SheetName As String
Dim rsSmartData As New ADODB.Recordset

rsSmartData.ActiveConnection = CurrentProject.Connection
rsSmartData.Open "SmartData"

'For each record in the Smart Data table send and e-mail

Do While Not rsSmartData.EOF

' mail construct goes here

strLtrContent = "Dear" & " " & rsSmartData("Customer Name") & ":" & vbCrLf & vbCrLf
strLtrContent = strLtrContent & "You have been selected to take part in our customer satisfaction survey, "
strLtrContent = strLtrContent & "Would you please take the time to compelete the attached form. "
strLtrContent = strLtrContent & vbCrLf & vbCrLf & "Please do NOT reply to the sender of this e-mail"
strLtrContent = strLtrContent & vbCrLf & vbCrLf & "Sincerly," & vbCrLf & vbCrLf
strLtrContent = strLtrContent & "Distributed Provisioning"

' This section is designed to open up the standard customer questionnaire
' and save the details per line item within this loop

ExcelApp.Visible = True
Set ExcelFile = ExcelApp.Workbooks.Open("S:\Admin- BF\ESCQ\Questionaire\ECSQ.xls")
Set ExcelSheet = ExcelApp.Worksheets("Answers")

With ExcelSheet

ActiveSheet.Unprotect ("****")

.Range("C2").Value = rsSmartData("Job ref")
.Range("D2").Value = rsSmartData("Unique Job Ref")
.Range("F2").Value = rsSmartData("Catalogue Description")
.Range("G2").Value = rsSmartData("Product Name")

ActiveSheet.Protect ("****")

End With

Excel.Application.DisplayAlerts = False
ExcelFile.Save
ExcelFile.Close True
ExcelApp.Quit

Set ExcelSheet = Nothing
Set ExcelFile = Nothing
Set ExcelApp = Nothing

' Prepares the mail for sending

Set objEmail = objOutlook.CreateItem(olMailItem)
objEmail.Recipients.Add rsSmartData("Recipient ID")
objEmail.Subject = "Order IT Customer Satisfaction Survey. "
objEmail.Body = strLtrContent
objEmail.Attachments.Add ("S:\Admin- BF\ESCQ\Questionaire\ECSQ.xls")

objEmail.Send

rsSmartData.MoveNext

Loop

End Sub

The problem seems to be that your are Protecting/Unprotecting the Worksheet within the context of the With...End With Construct:

With ExcelSheet
  ActiveSheet.Unprotect ("****")
 
  .Range("C2").Value = rsSmartData("Job ref")
  .Range("D2").Value = rsSmartData("Unique Job Ref")
  .Range("F2").Value = rsSmartData("Catalogue Description")
  .Range("G2").Value = rsSmartData("Product Name")
 
  ActiveSheet.Protect ("****")
End With

Which may evaluate to:

ExcelSheetActiveSheet.Unprotect ("****")
ExcelSheetActiveSheet.Protect ("****")

which is of course, meaningless.

[Smigger]

Thanks i've tried moving the code as below but obtain the same error, if I unprotect the file being opened and disable the unprotect / protect code within this module the script runs as required ??? Unfortunately I really need the protection on this document, any thoughts?

Activesheet.Unprotect("****")
 
With ExcelSheet
 
  .Range("C2").Value = rsSmartData("Job ref")
  .Range("D2").Value = rsSmartData("Unique Job Ref")
  .Range("F2").Value = rsSmartData("Catalogue Description")
  .Range("G2").Value = rsSmartData("Product Name")
 
End With
 
Activesheet.Protect("****")

[FishVal]

Hi, Smigger.

The code is executed in Access module. Am I right? If so, then you should refer to Excel.Application explicitely.

ExcelApp.Activesheet.Unprotect("****")
 

or even better if you have object variable referenced to target Worksheet, then it is more reliable to run Unprotect method of it.

With ExcelSheet
  .Activesheet.Unprotect("****")
  .Range("C2").Value = rsSmartData("Job ref")
  .Range("D2").Value = rsSmartData("Unique Job Ref")
  .Range("F2").Value = rsSmartData("Catalogue Description")
  .Range("G2").Value = rsSmartData("Product Name")
  .Activesheet.Protect("****")
End With
 

Regards,
Fish.

[ADezii]

Thanks i've tried moving the code as below but obtain the same error, if I unprotect the file being opened and disable the unprotect / protect code within this module the script runs as required ??? Unfortunately I really need the protection on this document, any thoughts?

Activesheet.Unprotect("****")
 
With ExcelSheet
 
  .Range("C2").Value = rsSmartData("Job ref")
  .Range("D2").Value = rsSmartData("Unique Job Ref")
  .Range("F2").Value = rsSmartData("Catalogue Description")
  .Range("G2").Value = rsSmartData("Product Name")
 
End With
 
Activesheet.Protect("****")

I think FishVal gave you some excellant advice. I tested the following subset of your code and it works flawlessly. Just parallel this code, and you shouold be OK.

Dim ExcelApp As New Excel.Application
Dim ExcelFile As New Excel.Workbook
Dim ExcelSheet As New Excel.Worksheet
Dim SheetName As String
 
 
ExcelApp.Visible = True
Set ExcelFile = ExcelApp.Workbooks.Open("C:\Test\Test.xls")
Set ExcelSheet = ExcelApp.Worksheets("Sheet1")
 
ExcelSheet.Unprotect Password:="TheProtector"
 
With ExcelSheet
  .Range("C2").Value = "Job ref"
  .Range("D2").Value = "Unique Job Ref"
  .Range("F2").Value = "Catalogue Description"
  .Range("G2").Value = "Product Name"
End With
 
ExcelSheet.Protect Password:="TheProtector"
 
Excel.Application.DisplayAlerts = False
ExcelFile.Save
ExcelFile.Close True
ExcelApp.Quit
 
Set ExcelSheet = Nothing
Set ExcelFile = Nothing
Set ExcelApp = Nothing
 

[Smigger]

Yes you absolutely right this is being run in an Access Module.

I'd already previously tried the code indicated within your response and shown below; however, I am still getting the same runtime error message.

Excel.Application.Activesheet.Unprotect("password")
 
With ExcelSheet
 
  .Range("C2").Value = rsSmartData("Job ref")
  .Range("D2").Value = rsSmartData("Unique Job Ref")
  .Range("F2").Value = rsSmartData("Catalogue Description")
  .Range("G2").Value = rsSmartData("Product Name")
 
End With
 
Excel.Application.Activesheet.Protect("password")

Below is the sum of the code within the access module I'm using at the moment, as mentioned before, if the protection lines 31 and 42 are removed everthing works as expected......

Sub ControlOutlook()
 
Dim objOutlook As New Outlook.Application
Dim objEmail As Outlook.MailItem
Dim strLtrContent As String
Dim ExcelApp As New Excel.Application
Dim ExcelFile As New Excel.Workbook
Dim ExcelSheet As New Excel.Worksheet
Dim rsSmartData As New ADODB.Recordset
 
rsSmartData.ActiveConnection = CurrentProject.Connection
rsSmartData.Open "SmartData"
 
'For each record in the Smart Data table send and e-mail
 
Do While Not rsSmartData.EOF
 
strLtrContent = "Dear" & " " & rsSmartData("Customer Name") & ":" & vbCrLf & vbCrLf
strLtrContent = strLtrContent & "You have been selected to take part in our customer satisfaction survey, "
strLtrContent = strLtrContent & "Would you please take the time to compelete the attached form. "
strLtrContent = strLtrContent & vbCrLf & vbCrLf & "Please do NOT reply to the sender of this e-mail"
strLtrContent = strLtrContent & vbCrLf & vbCrLf & "Sincerly," & vbCrLf & vbCrLf
strLtrContent = strLtrContent & "Distributed Provisioning"
 
' Excel call code here
 
ExcelApp.Visible = True
Set ExcelFile = ExcelApp.Workbooks.Open("S:\Admin- BF\ESCQ\Questionaire\ECSQ.xls")
Set ExcelSheet = ExcelApp.Worksheets("Answers")
 
Excel.Application.ActiveSheet.Unprotect ("password")
 
    With ExcelSheet
 
        .Range("C2").Value = rsSmartData("Order ID")
        .Range("D2").Value = rsSmartData("Orderline ID")
        .Range("F2").Value = rsSmartData("Product Description")
        .Range("G2").Value = rsSmartData("Product Name")
 
    End With
 
Excel.Application.ActiveSheet.Protect ("password")
 
Excel.Application.DisplayAlerts = False
ExcelFile.Save
ExcelFile.Close True
ExcelApp.Quit
 
Set ExcelSheet = Nothing
Set ExcelFile = Nothing
Set ExcelApp = Nothing
 
' Excel call code here
 
Set objEmail = objOutlook.CreateItem(olMailItem)
objEmail.Recipients.Add rsSmartData("Recipient ID")
objEmail.Subject = "Order IT Customer Satisfaction Survey. "
objEmail.Body = strLtrContent
objEmail.Attachments.Add ("S:\Admin- BF\ESCQ\Questionaire\ECSQ.xls")
 
objEmail.Send
 
rsSmartData.MoveNext
 
Loop
 
End Sub

[Smigger]

All resolved now, many thanks for your asistances.

The problem was an oversite on my part, I see now that the protection code should have read as below, without the Activesheet scripting

    With ExcelSheet
 
        .Unprotect ("password")
        .Range("C2").Value = rsSmartData("Order ID")
        .Range("D2").Value = rsSmartData("Orderline ID")
        .Range("F2").Value = rsSmartData("Product Description")
        .Range("G2").Value = rsSmartData("Product Name")
        .Protect ("password")
 
    End With