清除包含数据的单元格

Question

I am exporting information from emails into a spreadsheet using the following:

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\username\Desktop\Spreadsheet.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
 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), "Cell0:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("B" & rCount) = Trim(vItem(1))
            Else
            ActiveCell = Null
        End If

        If InStr(1, vText(i), "Field1:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("D" & rCount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "Field2:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("E" & rCount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "Field3:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("F" & rCount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "Field4:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("H" & rCount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "Field5:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("I" & rCount) = Trim(vItem(1))
        End If

        If InStr(1, vText(i), "Field6:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("J" & rCount) = Trim(vItem(1))
        End If


    Next i
    xlWB.Save
Next olItem


Set xlApp = Nothing
Set xlWB = Nothing
Set xlSheet = Nothing
Set olItem = Nothing
End Sub

The problem is if this is run on an email that does not contain data for a certain Field, it leaves the previous email's data. I would like to have the macro clear the cell if it contains information OR just input null into the cell if nothing is found in the Field.

I know it must be something like ActiveCell.clear or ActiveCell = Null but i'm just not sure where to put it in the If statements.

I tried this but it does not work:

If InStr(1, vText(i), "Activity Number:") > 0 Then
            vItem = Split(vText(i), Chr(58))
            xlSheet.Range("B" & rCount) = Trim(vItem(1))
            ElseIf InStr(1, vText(i), "Activity Number:") = 0 Then
            xlSheet.Range("B" & rCount) = Null
        End If

Answer 1

you could write a function that returns the range object after clearing it out.

Function ClearMyRange(r as Range) as Excel.Range
    r.ClearContents
    set ClearMyRange = r
End Function

then just call it

ClearMyRange(xlSheet.Range("D" & rCount)) = Trim(vItem(1))

The reason I suggested the function is so you don't have to call it like so

ClearMyRange(xlSheet.Range("D" & rCount))
xlSheet.Range("D" & rCount) = Trim(vItem(1))