[英]Clear cell if contains data
我正在使用以下方法將信息從電子郵件導出到電子表格中:
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
您可以編寫一個函數,將其清除后返回范圍對象。
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))
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.