Question

我正在尝试从以下电子邮件中提取2个字段。

您希望您的名字出现在参与证书上吗？   乔·约翰逊（样品名称）
  电子邮件地址必填Joe.Johnson@xxxmail.com

以及“必填”之后的电子邮件地址，即Joe.Johnson@xxxmail.com

我想将这两个字段导入Excel，以便我可以填充证书并将其返回到电子邮件地址。最终，我希望拥有可以完成上述所有操作的代码，但暂时我很高兴能使以下代码正常工作。

我在以下内容上遇到运行时错误：Set xlSheet = xlWB.Sheets("Sheet1")

Sub ExtractEmailData()
 Dim xlApp As Object
 Dim xlWB As Object
 Dim xlSheet As Object
 Dim olItem As Object
 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 = "D:\Joe\Documents\2018 TEAMS Certificate.xlsm" 'the path of the workbook

     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
    rCount = xlSheet.UsedRange.Rows.Count
    For Each olItem In Application.ActiveExplorer.Selection
        sText = olItem.Body
        vText = Split(sText, Chr(13))
        'Find the next empty line of the worksheet
        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), "PARTICIPATION?") > 0 Then
   vItem = Split(vText(i), Chr(60))
   vItem = Split(vItem(1), Chr(62))
   xlSheet.Range("A" & rCount) = Trim(vItem(1))

End If

If InStr(1, vText(i), "Email Address Required") > 0 Then
   vItem = Split(vText(i), Chr(58))
   xlSheet.Range("B" & 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

我是VBA的新手。

Answer 1

只是提供一个简单的解决方案，以防问题很简单。 “ D：\ Joe \ Documents \ 2018 TEAMS Certificate.xlsm”是否确实有一个名为“ Sheet1”的工作表？如果没有，也许你的意思是：

Set xlSheet = xlWB.Sheets(1)

引用Excel工作表会产生错误：未设置变量

1 个答案: