运行时错误“-2147221080 (800401a8)”：自动化错误

Question

我在尝试运行此宏时收到上述错误消息： （对不起尺寸和凌乱的状态） *

Private Sub CommandButton1_Click()

' Button to select one client from "Search Result" and fill their information in "Client Details"

'On Error GoTo CloseDataPool

' Make sure the Client Number cell is empty

If Range("B2") = "" Then
MsgBox ("Please enter valid client number")
Exit Sub
End If

' Give row value to Client Number
Search_Result = 4 + Range("B2")
If Cells(Search_Result, 1) <> Range("B2") Then
MsgBox ("Please enter valid client number")
Exit Sub
End If

' Find client in Data Pool via Broker Reference, then find their row number

Workbooks.Open "C:\Users\*\Dropbox\Shared Folder AT TH DH\Savant\*\Data Pool.xlsx"

Dim RC As Workbook
Dim DPW As Workbook
Dim DP As Worksheet
Dim SR As Worksheet
Dim CD As Worksheet
Dim PFDP As Worksheet
Set DPW = Workbooks("Data Pool")
Set DP = DPW.Worksheets("Data Pool")
Set RC = Workbooks("*")
Set SR = RC.Worksheets("Search Results")
Set CD = RC.Worksheets("Client Details")
Set PFDP = DPW.Worksheets("Prospect Fleet Data Pool")
Set PLDP = DPW.Worksheets("Prospect Liability Data Pool")

' Protect workbook and worksheets
CD.Protect Password:="*", UserInterfaceOnly:=True
SR.Protect Password:="*", UserInterfaceOnly:=True
DP.Protect Password:="*", UserInterfaceOnly:=True
PFDP.Protect Password:="*", UserInterfaceOnly:=True
PLDP.Protect Password:="*", UserInterfaceOnly:=True
RC.Protect Password:="*", Structure:=True
DPW.Protect Password:="*", Structure:=True

Search_Result = SR.Range("B2") + 4
x = DP.Cells(Rows.count, 1).End(xlUp).Row + 1
For Each Rowcheck In DP.Range("B2:B" & x)
If Rowcheck = SR.Range("B" & Search_Result) Then
y = Rowcheck.Row

CD.Range("E16") = DP.Cells(y, 1) 'Company Name
CD.Range("F38") = DP.Cells(y, 4) 'User added by
CD.Range("L38") = DP.Cells(y, 5) 'Date added on
End If
Next Rowcheck

Search_Result = CD.Range("F8")

Polcol = 2
Polrow = 45
x = PFDP.Cells(Rows.count, 1).End(xlUp).Row + 1
For Each Rowcheck In PFDP.Range("A2:A" & x)
If Rowcheck = Search_Result Then
y = Rowcheck.Row
CD.Cells(Polrow, Polcol) = Polrow - 44
CD.Cells(Polrow, Polcol + 2) = PFDP.Cells(y, 3)
Polrow = Polrow + 1
End If
Next Rowcheck

x = PLDP.Cells(Rows.count, 1).End(xlUp).Row + 1
For Each Rowcheck In PLDP.Range("A2:A" & x)
If Rowcheck = Search_Result Then
y = Rowcheck.Row
CD.Cells(Polrow, Polcol) = Polrow - 44
CD.Cells(Polrow, Polcol + 2) = PLDP.Cells(y, 3)
Polrow = Polrow + 1
End If
Next Rowcheck

'Add to history log
Set HLD = DPW.Worksheets("History Log")
HLD.Protect Password:="*", UserInterfaceOnly:=True
HLDR = HLD.Cells(Rows.count, 1).End(xlUp).Row + 1
HLD.Cells(HLDR, 1) = CD.Range("F8")

GoTo EndSub
CloseDataPool:
MsgBox ("An error has occurred")
EndSub:
Workbooks("Data Pool.xlsx").Save
Workbooks("Data Pool.xlsx").Close

End Sub

显示错误的行是：

Set HLD = DPW.Worksheets("History Log")

我试图将这条线移到我设置其他工作表的起点附近。我也将保护线移动到起点附近。当我这样做时，错误再次发生，但在下一行：

HLDR = HLD.Cells(Rows.count, 1).End(xlUp).Row + 1

我还在上面添加了一行来打开数据池工作簿，因为在谷歌搜索时，我发现在关闭的工作簿中查找项目可能会发生错误。但是，错误仍然存​​在。

我环顾四周，找不到解决方案。有人可以帮助我理解这个错误吗？

Answer 1

您发布的代码过多，无法获得量身定制的答案。相反，我将尝试以更一般的方式解释这个问题。像这样的行是您的问题的原因：

Workbooks.Open "C:\Users\*\Dropbox\Shared Folder AT TH DH\Savant\*\Data Pool.xlsx"
...
...
Workbooks("Data Pool.xlsx").Save

改为这样做：

Dim DataPool as Workbook
Set DataPool = Workbooks.Open("...\Data Pool.xlsx")
...
...
DataPool.Save

对该对象的所有其他引用都应该通过对象变量，而不是类。