Vba 从Outlook编辑Excel中的单元格，而不重新打开工作簿

我想使用VBA从Outlook编辑Excel中的单元格

我希望这样：
第一次运行宏时，单元格A1为“1”。
第二次运行宏时，单元格A2为“1”。
第三次运行宏时，单元格A3为“1”。
.
.
当我第五次运行宏时，它会返回到单元格A1，并将单元格A1的值从“1”增加到“2”

Dim count作为整数：count=1
作为整数的尺寸编号：编号=1
子测试（）
将xlApp作为对象
作为对象的Dim xlWB
将图纸作为对象
出错时继续下一步
Set xlApp=GetObject（，“Excel.Application”）
如果错误为0，则
设置xlApp=CreateObject（“Excel.Application”）
如果结束
错误转到0
如果（IsWorkBookOpen（“D:\Book1.xlsx”）=True），则“检查工作簿是否正在打开”
设置xlWB=xlApp.Workbooks（“D:\Book1.xlsx”）
其他的
设置xlWB=xlApp.Workbooks.Open（“D:\Book1.xlsx”）
如果结束
设置xlSheet=xlWB.Sheets（“Sheet1”）
如果（计数<5），则
xlSheet.Range（“A”&计数）=编号
计数=计数+1
其他的
计数=0
数字=数字+1
如果结束
端接头
函数IsWorkBookOpen（文件名为字符串）
长时间调暗ff，长时间调暗ErrNo
出错时继续下一步
ff=FreeFile（）
打开输入锁的文件名，读取为#ff
关闭ff
ErrNo=Err
错误转到0
选择案例错误号
案例0:IsWorkBookOpen=False
案例70:IsWorkBookOpen=True
案例：错误ErrNo
结束选择
端函数

---

上面写着“下标超出范围”。这行代码有问题：

Set xlWB=xlApp.Workbooks（“D:\Book1.xlsx”）

。当我调试时，我看到这一行高亮显示。

这是因为在

工作簿（…）

中，您隐式使用了

工作簿

对象的属性，该属性需要对象的名称或索引号，而您使用路径为其提供全名

使用

---

这是因为在使用

工作簿（…）

时，您隐式使用了

工作簿

对象的属性，该属性需要对象的名称或索引号，而您为其提供了带路径的全名

使用

---

Owesome，它跑了。非常感谢：）Owesome，它跑了。非常感谢：）

Dim count As Integer: count = 1
Dim number As Integer: number = 1

Sub test()
    Dim xlApp As Object
    Dim xlWB As Object
    Dim xlSheet As Object

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

    If (IsWorkBookOpen("D:\Book1.xlsx") = True) Then     'Check workbook is opening or not
        Set xlWB = xlApp.Workbooks("D:\Book1.xlsx")
    Else
        Set xlWB = xlApp.Workbooks.Open("D:\Book1.xlsx")
    End If

    Set xlSheet = xlWB.Sheets("Sheet1")

    If (count < 5) Then
        xlSheet.Range("A" & count) = number
        count = count + 1
    Else
        count = 0
        number = number + 1
    End If

End Sub


Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

Set xlWB = xlApp.workbooks("Book1.xlsx")