Runtime Error

Anonymous

When I attempt to open an excel file I get the following Runtime Error - Program: C:\Program Files (x86)\Microsoft Office\Office\EXCEL.EXE This application has requested the Runtime to terminate it in an unusual way. Please contact the applications support team for more information.

I'm running MS Office 2000 on Win Vista 64 bit. Any help would be appreciated.

Locked Question. This question was migrated from the Microsoft Support Community. You can vote on whether it's helpful, but you can't add comments or replies or follow the question.

0 comments

Answer accepted by question author

Anonymous

Step1:Check searching the complete computer for XLSTART and than delete the contents.

Step2: Follow the steps and check if that helps:

1.Go to the location C:\Program File\Microsoft Office\office\excel.exe

(if you are using a 64bit machine, then you would have to go to C:\Program files x86\Microsoft Office\Office\xcel.exe)

2.Right click on Excel.exe and click on Properties and then click on Compatibility tab. Check if you have any check mark in any of the compatibility mode options. Make sure you also click on the option "change settings for all users" tab at the bottom of the same screen and look for similar check boxes in the window.

3.Uncheck the option Run as Administrator option is you have it checked.

4.If you see any check boxes in the compatibility mode options, uncheck all the boxes and click on Apply and OK.

5.Try to open Excel now and check

Step3: Search for excel.xlb, *.qat and *.pip. Try searching and renaming this files. Check if excel works.

If still it doesn't work than, go for contorl panel> programs> programs & features> highlight office 2000 change> click on drop down of excel and make it NOT AVAILABLE.

Open registry: start> run >regedit> ok

Take back and then delete the EXCEL FOLDERS

Browse to HKEY_CURRENT_USER\Software\Microsoft\Office

Browse to HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office

Browse to HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\Microsoft\Office

Start> control panel> programs> programs & features> highlight office 2007> change> click on drop down of excel and make it AVAILABLE.

0 comments

9 additional answers

Anonymous

2017-10-19T11:42:33+00:00

Why i have problem with runtime error in my office account ?

i cant doing nothing

what you can doing for my office`s problem ?
Was this answer helpful?

0 comments No comments
Anonymous

2012-07-10T12:36:09+00:00

when you get the error, go into debug mode and hover you mouse over strTitleName in the split function in the line before the line with the error.

I suspect that strTitleName is an empty string and that is why myarray is empty and causes the error.

I can't tell you why the code does not have a valid entry for strTitleName

--

Regards,

Tom Ogilvy
Was this answer helpful?

0 comments No comments
Anonymous

2012-07-10T11:33:44+00:00
I am trying to open the sample email template wizard in excel 2010, I am getting runtime error '9': Subscription out of range , when I try to debug

it gives the error on line 198, col 5 as strNewTitleName = myArray(0)

The default template code is mentioned below. I have not edited any of the contents in the MS Excel template

Option Explicit

Dim arrFileNames As Class2

Dim arrFileLinks As Class2

Dim lRet

Dim lRetValue

Dim XMLDOC As MSXML2.DOMDocument

Dim strXMLPath As String, strXMLPath1 As String, strImg As String

Public blnValue As Boolean

Global strSupport As String

Public objFSO As New Outlook.Application

Sub EmailTemplates()

    If arrFileNames Is Nothing Then

    Set arrFileNames = New Class2

    Set arrFileLinks = New Class2

    End If

    strXMLPath1 = GetPath

    If (strXMLPath1 <> " ") Then

    strSupport = strXMLPath1

    End If

    Dim strURI As String, strHtmlSideBar As String, strHtmlText As String

    Dim ie As Object, objDocument As Object

    Dim lngStart As Long, lngEnd As Long, lngStartSideBar As Long, lngEndSideBar As Long, lngStartTitle As Long

    Dim lngEndTitle As Long

    Dim strInnerTitle As String, strHtmltitle As String, strInnerBody As String, strSideBody As String

    Dim MyItem As Outlook.MailItem

    Dim strTableFont As String, strInnerFont As String, strSideTitle As String, strSecondTable As String

    Dim strEntireTable As String, strSideStyle As String, strLink As String, strPathExcel As String

    Dim i As Integer

    If (arrFileNames.NumberOfItems <> 0) Then

    For i = 0 To arrFileNames.NumberOfItems - 1

    If arrFileLinks.GetItem(i) <> "" Or arrFileNames.GetItem(i) <> "" Then

    strSecondTable = strSecondTable & "<br><a href=" & arrFileLinks.GetItem(i) & ">" & arrFileNames.GetItem(i) & "</a>"

    End If

    Next

    End If

    '/*************************************************************/

    Set XMLDOC = New MSXML2.DOMDocument

    On Error GoTo ErrHandler

    'Retrive xml file name from created folder

    strXMLPath = strXMLPath1 & "\EmailTemplate.xml"

    XMLDOC.Load (strXMLPath)

    Dim strApplication As Integer

    Dim strLanguage As Integer

    With Sheet1.cmbApplication

    strApplication = .ListIndex + 1

    Dim id As Integer

    id = Sheet1.cmbArticle.ListIndex - 1

    strLink = XMLDOC.FirstChild.childNodes(0).FirstChild.childNodes(strApplication - 2).childNodes(2).childNodes(id).Text

    End With

ErrHandler:

    If Err <> 0 Then

    GoTo y

    MsgBox ("Operation Aborted.Please close the Excel sheet and reopen again")

    End

    Resume Next

    End If

    strURI = strLink

    Dim oHttp As Object

    lngEnd = 0

    Do While lngEnd = 0

    Set oHttp = CreateObject("MSXML2.XMLHTTP")

    oHttp.Open "GET", strURI, False

    oHttp.Send

    strHtmlText = oHttp.responseText

    lngStart = InStr(1, strHtmlText, "cdArticleBody")

    lngEnd = InStr(1, strHtmlText, "cdFeedbackControl")

    lngEnd = lngEnd - lngStart

    Loop

    strInnerBody = strInnerBody & Mid(strHtmlText, lngStart, lngEnd)

    strHtmltitle = oHttp.responseText

    lngStartTitle = InStr(1, strHtmltitle, "cdAssistCont")

    lngEndTitle = InStr(1, strHtmltitle, "cdArticleBody")

    lngEndTitle = lngEndTitle - lngStartTitle

    strInnerTitle = strInnerTitle & Mid(strHtmltitle, lngStartTitle, lngEndTitle)

    'TO get subject

    Dim strStartTitleName As String, strTitleName As String, strEndTitleforName As String

    strStartTitleName = InStr(1, strInnerTitle, "cdAssistanceTitle")

    strEndTitleforName = InStr(1, strInnerTitle, "</")

    strEndTitleforName = strEndTitleforName - strStartTitleName

    strTitleName = strTitleName & Mid(strInnerTitle, strStartTitleName, strEndTitleforName)

    strStartTitleName = InStr(1, strTitleName, ">")

    strEndTitleforName = Len(strTitleName)

    strTitleName = Mid(strTitleName, strStartTitleName + 1, strEndTitleforName)

    strHtmlSideBar = oHttp.responseText

    lngStartSideBar = InStr(1, strHtmlSideBar, "cdSideBoxBody")

    lngEndSideBar = InStr(1, strHtmlSideBar, "cdAdTitle")

    If (lngEndSideBar = 0) Then

    lngEndSideBar = InStr(1, strHtmlSideBar, "cdPrintBarBottom")

    End If

    If (lngStartSideBar = 0) Then

    strSideBody = "<UL>"

    ElseIf (lngEndSideBar = 0) Then

    strSideBody = "<UL>"

    Else

    lngEndSideBar = lngEndSideBar - lngStartSideBar

    strSideBody = strSideBody & Mid(strHtmlSideBar, lngStartSideBar, lngEndSideBar)

    lngStartSideBar = InStr(1, strSideBody, "cdSideBoxBody")

    lngEndSideBar = InStr(1, strSideBody, "</UL>")

    If (lngEndSideBar = 0) Then

    lngEndSideBar = InStr(1, strSideBody, "</ul>")

    End If

    'lngEndSideBar = lngEndSideBar - lngStartSideBar

    strSideBody = Mid(strSideBody, lngStartSideBar, lngEndSideBar - 1)

    End If

    Dim strHTML As String

    Dim intApplication1 As Integer

    With Sheet1.cmbApplication

    intApplication1 = .ListIndex + 1

     With Sheet1.cmbArticle

    Dim s As Integer

    Dim j1 As Integer

    s = XMLDOC.FirstChild.childNodes(0).FirstChild.childNodes(intApplication1 - 2).childNodes(3).childNodes((.ListIndex)).FirstChild.childNodes.Length

    For j1 = 0 To s - 1

    strHTML = strHTML & "<LI><a href=" & (XMLDOC.FirstChild.childNodes(0).FirstChild.childNodes(intApplication1 - 2).childNodes(3).childNodes(.ListIndex).childNodes(1).childNodes(j1).Text) & ">" & (XMLDOC.FirstChild.childNodes(0).FirstChild.childNodes(intApplication1
- 2).childNodes(3).childNodes(.ListIndex).FirstChild.childNodes(j1).Text) & "</a></LI>"
    Next

    End With

    End With

    strHTML = strHTML & "</UL>"

    strSideBody = strSideBody & strHTML

    ' To get Images

    strInnerBody = ReplaceMultiple(strInnerBody, "http://office.microsoft.com/global/", "/global")

    strPathExcel = SimpSet(ActiveWorkbook.FullName)

y:

    Set MyItem = objFSO.CreateItem(olMailItem)

    Dim strMoreLinks As String

    strMoreLinks = XMLDOC.FirstChild.childNodes(0).childNodes(1).childNodes(1).childNodes(6).Text

    strTableFont = """font-size:0.8em;font-family:Arial,Tahoma,Helvetica,sans-serif;color:#484848;line-height:1.1em;UL{font-size:28px; color:#7598c4}"""

    strInnerFont = """font-size:2.6em;color:#7598c4;font-family:Arial,Tahoma,Helvetica,sans-serif"""

    strSideTitle = """background-color:#BFBFBF;font-family:Arial,sans-serif;font-size:0.8em"""

    strSideStyle = """background-color:#D9D9D9;fontfamily:Arial,sans-serif;font-size:0.8em;line-height:1.1em"""

    strEntireTable = "<table><tr><td style=" & strSideTitle & ">" & strMoreLinks & "</td></tr><tr><td style=" & strSideStyle & ">" & "<div " & strSecondTable & "</td></tr></table>"

    If (arrFileNames.NumberOfItems = 0) Then

    strEntireTable = ""

    End If

    For i = 0 To arrFileNames.NumberOfItems - 1

    If arrFileLinks.GetItem(i) <> "" Or arrFileNames.GetItem(i) <> "" Then

    strEntireTable = "<table><tr><td style=" & strSideTitle & ">" & strMoreLinks & "</td></tr><tr><td style=" & strSideStyle & ">" & "<div " & strSecondTable & "</td></tr></table>"

    Exit For

    Else

    strEntireTable = ""

    End If

    Next

    Dim strMsgBody As String

    Dim strImage As String

    Dim strSignature As String

    If lRet = False And strImg = "" Then

    strImage = ""

    Else

    strImage = strImg

    End If

    strSignature = "Microsoft Online"

    Dim strReplace As String

    Dim intStartPosition As Integer

    Dim intEndPosition As Integer

    Dim utfCharacter As Variant

    Dim myArray() As String

    Dim iteration As Integer

    Dim strNewTitleName As String

    myArray = Split(strTitleName, "&")

    strNewTitleName = myArray(0)

    For iteration = 1 To UBound(myArray)

        myArray(iteration) = "&" + myArray(iteration)

        intStartPosition = InStr(myArray(iteration), "&")

        If (Mid(myArray(iteration), intStartPosition + 1, 1) = "#") Then

            intEndPosition = InStr(myArray(iteration), ";")

            strReplace = Mid(myArray(iteration), intStartPosition, intEndPosition)

            utfCharacter = Mid(myArray(iteration), intStartPosition + 2, intEndPosition - (intStartPosition + 2))

            If (IsNumeric(utfCharacter)) Then

                myArray(iteration) = Replace(myArray(iteration), strReplace, ChrW(utfCharacter))

            End If

        Else

            myArray(iteration) = Replace(myArray(iteration), """, """")

       End If

        strNewTitleName = strNewTitleName + myArray(iteration)

    Next

    strTitleName = strNewTitleName

    Dim strFirstTable As String

    Dim strSeeAlso As String

    strSeeAlso = XMLDOC.FirstChild.childNodes(0).childNodes(1).childNodes(1).childNodes(5).Text

    If (strImage <> "") Then

        strFirstTable = "<table style=" & strTableFont & "><tr><td colspan=2><img src =""" & strImage & """ /></td></tr><tr><td style=" & " height:25px;background-color:#DBE5F1" & " colspan=2></td></tr><tr><td width=100% colspan=2><img src =""" & strXMLPath1 & "img.gif" & """ ></td></tr><tr><td style=" & strInnerFont & ">" & strTitleName & "</td><td align=" & "right" & "><img src=""" & strXMLPath1 & "Practice.gif" & """></td></tr><tr><td colspan=2 valign=top><hr></td></tr><tr><td style=width:100px>" & "<div " & strInnerBody & "</td></tr></table>"

        strMsgBody = "<table width=100%><tr><td>" & strFirstTable & """</td><td valign=top style=width:200px><table><tr><td style=" & strSideTitle & ">" & strSeeAlso & "</td></tr><tr><td style=" & strSideStyle & ">" & "<div " & strSideBody & "</td></tr><tr><td valign=top>" & " <div " & strEntireTable & "</td></tr></table></td></tr></table>"

    Else

        strFirstTable = "<table style=" & strTableFont & "><tr><td style=" & " height:25px;background-color:#DBE5F1" & " colspan=2></td></tr><tr><td width=100% colspan=2><img src =""" & strXMLPath1 & "img.gif" & """ ></td></tr><tr><td style=" & strInnerFont & ">" & strTitleName & "</td><td align=" & "right" & "><img src=""" & strXMLPath1 & "Practice.gif" & """></td></tr><tr><td colspan=2 valign=top><hr></td></tr><tr><td style=width:100px>" & "<div " & strInnerBody & "</td></tr></table>"

        strMsgBody = "<table width=100%><tr><td>" & strFirstTable & """</td><td valign=top style=width:200px><table><tr><td style=" & strSideTitle & ">" & strSeeAlso & "</td></tr><tr><td style=" & strSideStyle & ">" & "<div " & strSideBody & "</td></tr><tr><td valign=top>" & " <div " & strEntireTable & "</td></tr></table></td></tr></table>"

    End If

    MyItem.BodyFormat = olFormatHTML

    MyItem.HTMLBody = strMsgBody

    MyItem.To = " "

    MyItem.Subject = "Office Online Getting Started : " & strTitleName

    MyItem.Display

    Set MyItem = Nothing

    lRet = False

    strImg = ""

    Set arrFileNames = Nothing

    Set arrFileLinks = Nothing

End Sub

Public Function ReplaceMultiple(ByVal OrigString As String, _

     ByVal ReplaceString As String, ParamArray FindChars()) _

     As String

        Dim lLBound As Long

        Dim lUBound As Long

        Dim lCtr As Long

        Dim strAns As String

        lLBound = LBound(FindChars)

        lUBound = UBound(FindChars)

        strAns = OrigString

        For lCtr = lLBound To lUBound

            strAns = Replace(strAns, CStr(FindChars(lCtr)), ReplaceString)

        Next

        ReplaceMultiple = strAns

End Function

Public Function SimpSet(ProcessString As String) As String

        Dim intPosition As Integer

        intPosition = InStr(ActiveWorkbook.FullName, "")

        SimpSet = Mid(ProcessString, 1, intPosition - 1)

End Function

Public Function GetPath() As String '<---Return supported path name

    On Error GoTo Error

    Dim blnCheck As Boolean

    Dim strPath As String

    Dim strDirectoryName As String

    If FileFolderExists(Environ("userprofile") & "\Documents") Then

        strPath = Environ("userprofile") & "\Documents"

    ElseIf FileFolderExists(Environ("userprofile") & "\My Documents") Then

        strPath = Environ("userprofile") & "\My Documents"

    Else

        strPath = Environ("userprofile")

    End If

    blnCheck = FileFolderExists(strPath)

    If blnCheck = False Then

        Dim lngIteration As Long

        Dim strPaths As String

        Dim varSplitEachDrive As Variant

        strPaths = "A:,B:,C:,D:,E:,F:,G:,H:,I:,J:,K:,L:,M:,N:,O:,P:,Q:,R:,S:,T:,U:,V:,W:,X:,Y:,Z:"

        varSplitEachDrive = Split(strPaths, ",")

        For lngIteration = 0 To UBound(varSplitEachDrive)

        strPath = varSplitEachDrive(lngIteration)

        blnCheck = FileFolderExists(strPath)

        If blnCheck = True Then

        If Len(Dir(strPath & "\EmailTemplate", vbDirectory)) = 0 Then

        MkDir (strPath & "EmailTemplate")

        strDirectoryName = strPath & "EmailTemplate"

        End If

        strDirectoryName = strPath & "EmailTemplate"

        Exit For

        End If

        Next lngIteration

    Else

        If Len(Dir(strPath & "\EmailTemplate", vbDirectory)) = 0 Then

            MkDir (strPath & "EmailTemplate")

            strDirectoryName = strPath & "EmailTemplate"

        End If

        strDirectoryName = strPath & "EmailTemplate"

    End If

    GetPath = strDirectoryName

Error:

    On Error GoTo 0

End Function

Public Function FileFolderExists(strFullPath As String) As Boolean

    On Error GoTo EarlyExit

    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True

EarlyExit:

    On Error GoTo 0

End Function

Sub Button79_Click()

         If ((Sheet1.cmbApplication.Value = "") Or (Sheet1.cmbApplication.ListIndex = 0)) Then

            MsgBox ("Please select the application")

            ElseIf ((Sheet1.cmbArticle.Value = "") Or (Sheet1.cmbArticle.ListIndex = 0)) Then

            MsgBox ("Please select the Article")

            Else

        Dim arTemp() As Variant

        Dim Filter As String

        Dim blnCheck As Boolean

        Dim strCheck As String

        Dim strCheckExtentions As String

        On Error GoTo Err_Clr

        'Default method Uses Open Dialog To Show the Files

        If blnValue = False Then

        'Set arrFileNames = New Class2

        End If

        Filter = "JPG (*.JPG) (*.JPG),*.JPG," & _

                 "PNG (*.PNG) (*.PNG),*.PNG," & _

                 "JPEG (*.JPEG) (*.JPEG),*.JPEG," & _

                 "GIF (*.GIF) (*.GIF),*.GIF," & _

                 "BMP (*.BMP) (*.BMP),*.BMP"

L:

        strCheck = UCase(Application.GetOpenFilename(Filter))

        If InStr(strCheck, "JPG") <> 0 Then

        lRet = strCheck

        ElseIf InStr(strCheck, "PNG") <> 0 Then

        lRet = strCheck

        ElseIf InStr(strCheck, "JPEG") <> 0 Then

        lRet = strCheck

        ElseIf InStr(strCheck, "GIF") <> 0 Then

        lRet = strCheck

        ElseIf InStr(strCheck, "BMP") <> 0 Then

        lRet = strCheck

        ElseIf strCheck = "FALSE" Then

        lRet = "False"

        Else

        MsgBox ("Please select the valid Logo")

        GoTo L

        End If

        If lRet <> "False" Then

            strImg = lRet

        End If

        Return

Err_Clr:

        If Err <> 0 Then

        Err.Clear

        Resume Next

        End If

        End If

End Sub

Sub ExportPictures(path As String) '<--- Export images to folder

On Error GoTo ErrHandler

    ActiveSheet.ChartObjects(1).Chart.Export Filename:=path & "\Practice.gif", FilterName:="gif"

    ActiveSheet.ChartObjects(2).Chart.Export Filename:=path & "\img.gif", FilterName:="gif"

ErrHandler:

        If Err <> 0 Then

        MsgBox ("Required supported files were not Saved .Please try it again.")

        End If

End Sub

Sub Button78_Click()

    If ((Sheet1.cmbApplication.Value = "") Or (Sheet1.cmbApplication.ListIndex = 0)) Then

    MsgBox ("Please select the application")

    ElseIf ((Sheet1.cmbArticle.Value = "") Or (Sheet1.cmbArticle.ListIndex = 0)) Then

    MsgBox ("Please select the Article")

    Else

    'ActiveSheet.Range("C24").Select

    blnValue = True

    If arrFileLinks Is Nothing And arrFileNames Is Nothing Then

    Set arrFileNames = New Class2

    Set arrFileLinks = New Class2

    End If

        Dim MyText As String

        Dim MyLink As String

        Dim msg As String, Title As String

        Dim Config As Integer, Ans As Integer

        msg = "Do you want to add another hyperlink ?"

        'HideCursor

        On Error Resume Next

        Title = "Confirm Text and Link Addition"

        Config = vbYesNo + vbExclamation

Some_label:

        InputName.txtData.Value = ""

        InputName.txtData.SetFocus

        InputName.Show

        InputName.lblData.Caption = "Enter the text to display"

        MyText = InputName.txtData.Value

        InputLinkData.txtLinkData.Value = ""

        InputLinkData.txtLinkData.SetFocus

        InputLinkData.Show

        InputLinkData.lblData.Caption = "Enter the link for the text"

        MyLink = InputLinkData.txtLinkData.Value

        If (MyText = "False") Then

        MyText = ""

        End If

        If (MyLink = "False") Then

        MyLink = ""

        End If

        Ans = MsgBox(msg, Config, Title)

        arrFileNames.Add (MyText)

        arrFileLinks.Add (MyLink)

        If Ans = 6 Then

        GoTo Some_label

        Else

        End If

        End If

'ActiveSheet.Protect

End Sub

Sub Button80_click()

    Dim strValue As String

    Dim strPosition As String

    If ((Sheet1.cmbApplication.Value = "") Or (Sheet1.cmbApplication.ListIndex = 0)) Then

    MsgBox ("Please select the application")

    ElseIf ((Sheet1.cmbArticle.Value = "") Or (Sheet1.cmbArticle.ListIndex = 0)) Then

    MsgBox ("Please select the Article")

    Else

    strValue = Sheet1.cmbArticle.Text

    strPosition = InStr(1, strValue, "Not Valid Link")

    If strPosition = 0 Then

    Call EmailTemplates

    Else

    MsgBox ("Operation Aborted.Please close the Excel sheet and reopen again")

    End If

    End If

End Sub

Public Sub RetirevePath(strDirectoryPath As String)

    strXMLPath1 = strDirectoryPath

    strXMLPath = strXMLPath1 & "\EmailTemplate.xml"

End Sub
Was this answer helpful?

0 comments No comments
Anonymous

2010-06-25T11:04:01+00:00

After searching for excel.xlb as per Step3 (2) workbooks were found. I renamed both & excel now works! I didn't need to search for *.qat or *.pip files, nor do I understand what type of files they are, or why renaming the 2 workbooks was sucessful? Thanks for the help!

Thanks for replying and marking it as answer, so that it will be helpful for others!

Corrupted Excel toolbar file (Excel.xlb) .

For more information check http://support.microsoft.com/kb/919196
Was this answer helpful?

0 comments No comments

Share via

Runtime Error

9 additional answers