1

I've got an issue with some code when I've tried to install some code on a colleagues machine. The machine and version of Outlook are exactly the same and reference the same libraries. However, when I try and run the script on her machine, it throws up an error 91 on the 'Set xlWB = xlApp.Workbooks.Open(strPath)'.

The intention is to export necessary data from a selected email message into an Excel spreadsheet located in a specified directory.

Any clues as to what I should be trying in order to eliminate the error? First half of the code below.

Many thanks!

Option Explicit
 Sub ServiceRequestTool()
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim rCount As Long
 Dim bXStarted As Boolean
 Dim enviro As String
 Dim strPath As String
 Dim currentExplorer As Explorer
 Dim Selection As Selection
 Dim olItem As Outlook.MailItem
 Dim obj As Object
 Dim strColA, strColB, strColC As String

     strPath = "H:\My Documents\General Docs\Govtnz-Service-Request.xlsm"

     On Error Resume Next
     Set xlApp = GetObject(, "Excel.Application")
     If Err <> 0 Then
        If Dir$("H:\My Documents\General Docs\Govtnz-Service-Request.xlsm") = "" Then
            MsgBox "Contact the spreadsheet administrator for assistance.", vbOKOnly + vbCritical, "File not found!"
            Exit Sub
        End If
     End If
     On Error GoTo 0
     Set xlWB = xlApp.Workbooks.Open(strPath)
     Set xlSheet = xlWB.Sheets("requestAssignment")

    On Error Resume Next

rCount = xlSheet.Range("C" & xlSheet.Rows.Count).End(-4162).Row + 1

Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
  For Each obj In Selection

    Set olItem = obj

    strColA = olItem.SenderName
    strColB = olItem.SenderEmailAddress
    strColC = olItem.ReceivedTime


  xlSheet.Range("B" & rCount) = strColC
  xlSheet.Range("C" & rCount) = strColA
  xlSheet.Range("D" & rCount) = strColB

  rCount = rCount + 1

 Next

     xlWB.Close 1
     If bXStarted Then
         xlApp.Quit
     End If

     Set olItem = Nothing
     Set obj = Nothing
     Set currentExplorer = Nothing
     Set xlApp = Nothing
     Set xlWB = Nothing
     Set xlSheet = Nothing
 End Sub
Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
jeden
  • 17
  • 1
  • 1
  • 8
  • 1
    Possible duplicate of [VBA: Run time error '91'?](http://stackoverflow.com/questions/18927297/vba-run-time-error-91) – Marged Apr 14 '16 at 03:28
  • Are the hard coded file paths accessible on the other machine? – Comintern Apr 14 '16 at 03:31
  • Is 'H' drive on your colleagues machine the same 'H' drive as yours? Use the UNC name instead (e.g. \\MyServerName\MyFolder\). Also check `GetObject` - Siddarth outlines that in his answer. Edit - scratch that, you check it exists with the `Dir`. – Darren Bartrup-Cook Apr 14 '16 at 16:12

1 Answers1

1

You are most probably getting that error because there is no instance of Excel which is running.

  1. You need to create a new instance when GetObject doesn't find one.
  2. You are checking for the existence of the file if Err <> 0? i.e when no Excel instance is found? That doesn't make sense. Check for the existence of the file first and then check for Excel.

Is this what you are trying? (untested)

Change your code

 On Error Resume Next
 Set xlApp = GetObject(, "Excel.Application")
 If Err <> 0 Then
    If Dir$("H:\My Documents\General Docs\Govtnz-Service-Request.xlsm") = "" Then
        MsgBox "Contact the spreadsheet administrator for assistance.", _
        vbOKOnly + vbCritical, "File not found!"
        Exit Sub
    End If
 End If
 On Error GoTo 0

to

'~~> Move ths out of that IF/EndIf
If Dir$("H:\My Documents\General Docs\Govtnz-Service-Request.xlsm") = "" Then
    MsgBox "Contact the spreadsheet administrator for assistance.", _
    vbOKOnly + vbCritical, "File not found!"
    Exit Sub
End If

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
   Set xlApp = CreateObject("Excel.Application") '<~~ Add this line
End If
On Error GoTo 0

If xlApp Is Nothing Then
    MsgBox "Excel is not installed"
    Exit Sub
End If
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250