从Outlook确定Excel中单元格的值

时间:2018-01-10 23:06:25

标签: excel vba outlook outlook-vba

我正在使用Outlook VBA查找Excel工作表上的单元格是否为空。

代码将在单元格中写入电子邮件中的内容,但无法在单元格中注册任何值。

使用MAPI等进行正常的Outlook VBA设置后,代码为:

Dim xlapp As Excel.Application
Dim xlwb As Excel.Workbook
Dim xlws As Excel.Worksheet
Dim x, y As Long          
Dim Iscellempty As Boolean
Dim Budapest As Range
Iscellempty = False

这将打开文件,但如果已经打开则不会重新打开

Set xlapp = GetObject(, "excel.application")
On Error Resume Next        
Set xlwb = xlapp.Workbooks("Excel test.xlsm")    
If xlwb Is Nothing Then      
    xlapp.Workbooks.Open ("U:\Workarea\Automation Tool\AmendCancel report\Excel test.xlsm")      
    Set xlwb = xlapp.Workbooks("Excel test.xlsm")
   Else   
End If

Set xlws = xlwb.Sheets(1)    
If xlwb Is Nothing Then
    MsgBox "Required file is not available"
End If

x = 2
y = CLng(Date) - 43105

下一部分是问题。当将光标悬停在'Budapest'上时,它总是会说'Nothing'(并且在添加.value时没有说任何内容。

Set Budapest = xlws.Cells(y, 3)
Do
With xlwb.Worksheets(1) etc....

此后的If语句无法触发提供相同的输出,无论该单元格是否为空。

1 个答案:

答案 0 :(得分:0)

要简单检查Outlook中的单元格值是否为空,您可以使用IsEmpty Function

Set rCell = Sht.Range("A1")
If Not IsEmpty(rCell.value) Then
    Debug.Print rCell.value
End If

或另一个避免空格的示例

Set rCell = Sht.Range("A1")
If Not Len(Trim(rCell.value)) = 0 Then
    Debug.Print rCell.value
End If

以下是Outlook的完整示例,它将打开Excel文件或重新打开Excel文件

Option Explicit
Public Sub Example()
    Dim xlApp As Excel.Application
    Dim Book As Excel.Workbook
    Dim Sht As Excel.Worksheet
    Dim xlStarted As Boolean
    Dim FilePath As String
    Dim rCell As Range

'   // File Path
    FilePath = "C:\Temp\Book1.xlsm"

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err <> 0 Then
        Set xlApp = New Excel.Application
            xlStarted = True
    End If
    On Error GoTo 0

'   // Open Workbook, Sheet1 to get data
    Set Book = xlApp.Workbooks.Open(FilePath)
    Set Sht = Book.Sheets("Sheet1")

'   // Set range variable
    Set rCell = Sht.Range("A1")
    If Not Len(Trim(rCell.value)) = 0 Then
        Debug.Print rCell.value ' Immediate Window
    End If

    Set rCell = Sht.Range("A1")
    If Not IsEmpty(rCell.value) Then
        Debug.Print rCell.value ' Immediate Window
    End If

'   // Close & SaveChanges
    Book.Close SaveChanges:=True
    If xlStarted Then
        xlApp.Quit
    End If

    Set xlApp = Nothing
End Sub