透明细胞是否包含数据

Question

我从邮件使用导出信息到电子表格如下：

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 

，如果这是在不包含数据的某一个领域的电子邮件运行的问题是，它的叶子以前的电子邮件数据。我想让宏清除包含信息的单元格，或者如果在字段中找不到任何内容，只需向单元格中输入null即可。

我知道它一定是类似ActiveCell.clear或ActiveCell = Null但我只是不知道该把它放在If语句中。

我试过，但它不工作：

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

你可以写，清除出后返回范围对象的功能。

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

然后叫它

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

我建议的功能的原因，所以你不必跟我这样称呼它使

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