“运行时错误'9'下标超出范围"尝试从Outlook将电子邮件正文获取到Excel文件时显示 [英] "Run time error '9' Subscript out of range" shows up while trying to fetch the Email body from outlook to Excel file

问题描述

我正在尝试使用以下编码从Outlook将Email正文的一部分提取到Excel文件.它给我以下错误，错误代码为运行时错误'9'下标超出范围" ，如以下代码中所指定.有人可以在下面查看我的代码并为我提供帮助.谢谢

I am trying to fetch the part of the Email body from outlook to Excel file using the following coding. It is giving me error as "Run time error '9' Subscript out of range " as specified in the coding below. Would someone please review my code below and help me out. Thank you

我的代码:

Sub try()
Dim vText As Variant

Dim sText As String

Dim vItem As Variant

Dim str2 As String

Dim subject As String

Set myOlApp = Outlook.Application

Set mynamespace = myOlApp.GetNamespace("mapi")

Set myfolder = myOlApp.ActiveExplorer.CurrentFolder

Set xlobj = New Excel.Application

xlobj.Visible = True

xlobj.Workbooks.Add

xlobj.Worksheets("Sheet1").Name = "Statusmail"

xlobj.Range("A1").Value = "Caller Name"

xlobj.Range("B1").Value = "Caller Requirement"

xlobj.Range("C1").Value = "Caller Phone"

xlobj.Range("D1").Value = "Caller Company"

xlobj.Range("E1").Value = "Caller Email"

xlobj.Range("F1").Value = "Call Date & Time"

xlobj.Range("G1").Value = "Branch Info"

xlobj.Range("H1").Value = "City"

 For i = 1 To myfolder.Items.Count

  Set myItem = myfolder.Items(i)

  msgtext = myItem.Body

  sText = myItem.Body

  subject = myItem.subject

  If InStr(1, subject, "enquiry for you", vbTextCompare) Then

  vText = Split(sText, Chr(13))

    For j = UBound(vText) To 0 Step -1

      If ((InStr(1, vText(j), "Caller Name:") > 0) Or (InStr(1, vText(j), "Name :") > 0)) Then

            vItem = vText(j + 1)

            xlobj.Range("A" & i + 1).Value = Trim(vItem)

        End If
       If InStr(1, vText(j), "Caller Requirement:") > 0 Then

            vItem = vText(j + 1)

            xlobj.Range("B" & i + 1).Value = Trim(vItem)

        End If
        If ((InStr(1, vText(j), "Caller Phone:") > 0) Or (InStr(1, vText(j), "Phone :") > 0)) Then

            vItem = vText(j + 1)

            xlobj.Range("C" & i + 1).Value = Trim(vItem)

        End If
        If InStr(1, vText(j), "Caller Company:") > 0 Then

            vItem = vText(j + 1)

            xlobj.Range("D" & i + 1).Value = Trim(vItem)

        End If
        If InStr(1, vText(j), "Caller Email:") > 0 Then

            vItem = vText(j + 1)
            If Not IsEmpty(vItem) Then
            Dim str1 As String
            If InStr(1, vItem, ":") > 0 Then
            vItem = Split(vItem, Chr(58))
            str1 = vItem(1)
            End If
            vItem = Split(str1, Chr(34))
         ' BELOW LINE GIVES ERROR  
            xlobj.Range("E" & i + 1).Value = vItem(0)   ' THIS LINE IS GIVING ERROR
            End If

        End If
        If ((InStr(1, vText(j), "Call Date & Time:") > 0) Or (InStr(1, vText(j), "Call Date :") > 0)) Then

            vItem = vText(j + 1)

            xlobj.Range("F" & i + 1).Value = Trim(vItem)

        End If
        If InStr(1, vText(j), "Branch Info:") > 0 Then

            vItem = vText(j + 1)

            xlobj.Range("G" & i + 1).Value = Trim(vItem)

        End If
        If ((InStr(1, vText(j), "City:") > 0) Or (InStr(1, vText(j), "City Name :") > 0)) Then

            vItem = vText(j + 1)

            xlobj.Range("H" & i + 1).Value = Trim(vItem)

        End If
       Next
  End If

Next

End Sub

推荐答案

如果这行:

If InStr(1, vItem, ":") > 0 Then

不符合条件，则下一步将执行此行

doesn't meet criteria than this line will be executed next

vItem = Split(str1, Chr(34))

实际上试图拆分空的 str1变量.结果，您的数组为空，导致运行时错误'9'指的是下一行的右部分:

which in fact trying to split empty str1 variable. As a result your Array is empty causing Run-time error'9' referring to right part of the next line:

xlobj.Range("E" & i + 1).Value = vItem(0)  

因此， VItem(0)是您的问题，而它不存在.

So, VItem(0) is your problem while it doesn't exist.

这篇关于“运行时错误'9'下标超出范围"尝试从Outlook将电子邮件正文获取到Excel文件时显示的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！