我在我们的网站上有一个表单，它会生成一封如下所示的电子邮件：
First Name: test
Last Name: test
Address1: test
Address2:
City: test
State: CA
Zip Code: 90032
Email: test@yahoo.com
Telephone:
Date of Birth: -Month- -Day- -Year-
Marital Status:
Purchase Month: April
Purchase Day: -Day-
Purchase Year: 2004
Purchase Place: test
Purchase Place Other:
Product type: test
Other Product Type:
Product size: test
Other Product Size:
Product color: test
Did you buy this for yourself or received as a gift? self
Which of the following product types do you own or intend to own?
• Skillets & Grills
• Specialty
• Stockpots
• Cast Iron Ovens & Braisers
• Kettles
• Bakeware
• Kitchen Tools
• Wine Tools
Is this your first product? no
What do you like to cook?
• Slow Cooking
• Kid Friendly Meals
• Quick and Easy
Would you like to receive email updates and special offers? yes
comments:
我正在尝试将电子邮件内容放入Excel中，以便每行都是列标题，用户提交的信息将进入标题下的行。有时字段可能留空（不是所有字段都是必需的）。我找到了this post并更新了表单字段以匹配我自己的表单和电子表格的路径。当我运行它时，电子表格打开但我得到“运行时错误9，下标超出范围消息。如果我单击调试＆gt;切换断点它突出显示第一行。
这是我正在使用的脚本。任何人都可以审查并帮助使这项工作？我之前从未使用过宏或VBA，所以这对我来说都是陌生的。我在网上搜索了这个错误，但我发现的一切都非常具体，对我没有帮助。 Here，here和here是我所看到的几个例子。
Option Explicit
Sub CopyToExcel()
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim olItem As Outlook.MailItem
Dim vText As Variant
Dim sText As String
Dim vItem As Variant
Dim i As Long
Dim rCount As Long
Dim bXStarted As Boolean
Const strPath As String = "C:\Users\llantz\Desktop\prod-reg.xlsx" 'the path of the workbook
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox "No Items selected!", vbCritical, "Error"
Exit Sub
End If
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")
'Process each selected record
For Each olItem In Application.ActiveExplorer.Selection
sText = olItem.Body
vText = Split(sText, Chr(13))
'Find the next empty line of the worksheet
rCount = xlSheet.UsedRange.Rows.Count
rCount = rCount + 1
'Check each line of text in the message body
For i = UBound(vText) To 0 Step -1
If InStr(1, vText(i), "First Name:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("B" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Last Name:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("C" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Address1:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("D" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Address2:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("E" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "City:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("F" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "State:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("G" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Zip Code:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("H" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Email:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("I" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Telephone:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("J" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Date of Birth:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("K" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Marital Status:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("L" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Purchase Month:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("M" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Purchase Day:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("N" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Purchase Year:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("O" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Purchase Place:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("P" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Purchase Place Other:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("P" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Product type:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("P" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Other Product Type:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("P" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Product size:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("P" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Other Product Size:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("P" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Product color:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("P" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Did you buy this for yourself or received as a gift?") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("P" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Which of the following product types do you own or intend to own?") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("Q" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Is this your first Le Creuset product?") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("Q" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "What do you like to cook?") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("Q" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "Would you like to receive email updates and special offers from Le Creuset?") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("Q" & rCount) = Trim(vItem(1))
End If
If InStr(1, vText(i), "comments:") > 0 Then
vItem = Split(vText(i), Chr(58))
xlSheet.Range("Q" & rCount) = Trim(vItem(1))
End If
Next i
xlWB.Save
Next olItem
xlWB.Close SaveChanges:=True
If bXStarted Then
xlApp.Quit
End If
Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set olItem = Nothing
End Sub
答案 0 :(得分：3)
在某些后来的项目中，该行中没有冒号，例如：
“您是自己购买还是作为礼物收到的？”
因此，用冒号（：，即字符58）拆分它只会创建一个单元素数组：
vItem = Split(vText(i), Chr(58))
在下一行中，您尝试引用数组的第二个元素（Split数组从零开始，因此(vItem(1)是第二个元素）：
xlSheet.Range("P" & rCount) = Trim(vItem(1))
由于没有第二个元素，因此会出现“错误9 - 下标超出范围。”