我有一个表单,它调用Module1中的一些子进程。在Module1中,我有一个公开声明的对象变量。使用该变量的想法是创建一个后期绑定的scripting.dictionary
,以避免必须添加太多引用到我当前的vba项目。字典已成功创建并填充在Sub1中。但是,一旦Sub1完成并调用Sub2,我注意到字典变量已恢复为其原始类型的Object。
登录表格:
Public progresslbl As Object, subprogresslbl As Object, progressbar As Object, webBr As Object
Private Sub GetExports_Click()
...
...
...
progresslbl.Caption = "Requesting Exports"
RequestExports
'Wait for all emails to be received (reset currentsupplier and count emails, wait for currentsupplier = suppliercount)
WaitforEmails 'Still needs to be created
'Download Exports & Save them to destination user specifies
DownloadFiles
'Restore Outlook: remove temp folder and rule
progresslbl.Caption = "Restoring Outlook Settings"
RestoreOutlook
模块1:
Public IE As Object, downloadTo As String, Outlook As Object, Items As Object, err As Integer, itemdic As Object
'itemdic shows as type Object in Watch window
Sub RequestExports()
Set itemdic = CreateObject("Scripting.Dictionary"): itemdic.comparemode = vbTextCompare
'itemdic now shows at type scripting.dictionary in Watch window
For x = 1 To suppliercount
With IE.Document
esplogin.subprogresslbl.Caption = "Searching for Supplier " & x & " of " & suppliercount
currentsupplier = ActiveSheet.Range("A" & x).Value
delay 3 'Wait 3 seconds to allow screen to load fully
.getElementById("supplierSearchTextBox").Focus 'Select Search Box
.getElementById("supplierSearchTextBox").Value = currentsupplier 'Fill in Search Box
'Invoke keypress event so the contents are detected
Set evt = .CreateEvent("keyboardevent"): evt.initEvent "change", True, False
.getElementById("supplierSearchTextBox").dispatchEvent evt
Dim searchButton As Object: Set searchButton = .getElementsByTagName("a")(5)
searchButton.Click
delay 3
Dim supplierLink As Object: Set supplierLink = .getElementsByTagName("a")(6)
'Cycle through list of suppliers in excel until we find another active one
Do While supplierLink Is Nothing
err = err + 1
esplogin.subprogresslbl.Caption = "Supplier Not Found"
delay 1
ActiveSheet.Range("A" & x).Interior.Color = vbYellow
If x = suppliercount Then Exit For
esplogin.progressbar.Width = 150 / suppliercount * x
x = x + 1
esplogin.subprogresslbl.Caption = "Searching for Supplier " & x & " of " & suppliercount
currentsupplier = ActiveSheet.Range("A" & x).Value
'Select & Fill in Search Box
.getElementById("supplierSearchTextBox").Focus
.getElementById("supplierSearchTextBox").Value = currentsupplier
'Invoke keypress event so the contents are detected
Set evt = .CreateEvent("keyboardevent"): evt.initEvent "change", True, False
.getElementById("supplierSearchTextBox").dispatchEvent evt
Set searchButton = .getElementsByTagName("a")(5)
searchButton.Click
delay 2
Set supplierLink = .getElementsByTagName("a")(6)
Loop
'Login to supplier
supplierLink.Click
While IE.Busy
DoEvents
Wend
esplogin.subprogresslbl.Caption = "Exporting Supplier " & x & " of " & suppliercount
delay 4
Dim exportButton As Object: Set exportButton = .getElementsByTagName("button")(3)
exportButton.Click
delay 1
.getElementsByTagName("select")(0).Value = "all"
.getElementsByTagName("select")(1).Value = "5"
delay 1
.getElementById("btnExport").Click 'Click Export button
delay 2
'Click Ok button to close "Export sent to email" window
Dim exportResultOK As Object: Set exportResultOK = .getElementById("exportProductModalResul").getElementsByTagName("button")(1)
exportResultOK.Click
esplogin.subprogresslbl.Caption = "Awaiting Export Confirm. Email for Supplier " & x & " of " & suppliercount
delay 1
Set eitDashboardButton = .getElementsByTagName("a")(11)
eitDashboardButton.Click
End With
'Check to see if latestExport confirmation has arrived yet
Set latestExport = Items.Find("[Subject] = ""Product Updates Product Export confirmation""")
'If we haven't already found the latestExport wait and keep checking until we do
Do While latestExport Is Nothing
Set latestExport = Items.Find("[Subject] = ""Product Updates Product Export confirmation""")
Loop
esplogin.subprogresslbl.Caption = "Received Confirm. Email for Supplier " & x & " of " & suppliercount
With latestExport
BatchID = Mid(.Body, InStr(1, .Body, "Batch ID of ", vbTextCompare) + 12, InStrRev(.Body, ".", Len(.Body) - 1, vbTextCompare) - (InStr(1, .Body, "Batch ID of ", vbTextCompare) + 12))
itemdic.Add currentsupplier, BatchID
latestExport.Subject = "Product Updates Product Export confirmation - " & currentsupplier
latestExport.Save 'Save the updated subject
End With
esplogin.progressbar.Width = 150 / suppliercount * x
Next x
esplogin.progresslbl.Caption = "Export Requests Complete"
IE.Quit
Set IE = Nothing
Exit Sub
Restore:
RestoreOutlook
MsgBox ("Issue with Export code")
End Sub
Sub WaitforEmails(Optional currentcount As Integer = 0)
////As soon as the code reaches this point the item dic variable is now a type Object again and has no values
Dim item As Object, BatchID As String, k As Object
For Each item In Items
With item
If .Subject = "Product Updates: Product Export" Then
'Instr check for batch id (ie dic key) then whatever dic value it matches replace batch id in dic with download link
For Each k In itemdic.keys
If InStr(1, .HTMLBody, k, vbTextCompare) > 0 Then
'Store the download link in place of the batch id
itemdic(k) = Mid(.HTMLBody, InStr(1, .HTMLBody, "a href=") + 8, (InStrRev(.HTMLBody, ">here") - 2) - (InStr(1, .HTMLBody, "a href=") + 8))
Exit For
End If
Next
currentcount = currentcount + 1
If currentcount = (suppliercount - errs) Then Exit For 'we have all of the emails
End If
End With
Next
If Not currentcount = (suppliercount - errs) Then Application.OnTime Now + TimeValue("00:01:00"), "WaitforEmails(currentcount)"
While Not currentcount = (suppliercount - errs)
DoEvents
Wend
Exit Sub
Restore:
RestoreOutlook
MsgBox ("Issue with WaitforEmail code")
End Sub
'When moving to sub 2 itemdic now reverts back to showing as type Object in Watch window
Sub 2()
'Work with items in dictionary
'Application or Object-defined Error I believe?
'Some error
End Sub
我的问题:
有没有办法让后期绑定的字典变量保持其类型(及其内容/值)跨子(在Module1中)而不必添加引用?
答案 0 :(得分:1)
Sub1
中的某些内容必须重置您的项目。
以下工作正常:
Public D As Object
Sub sub1()
Set D = CreateObject("Scripting.Dictionary")
D.Add "hello", "world"
End Sub
Sub sub2()
Debug.Print D("hello")
End Sub
Sub test()
sub1
sub2 'prints "world" in the immediate window
End Sub
但是 - 以下方式有所不同:
Public D As Object
Sub sub1()
Set D = CreateObject("Scripting.Dictionary")
D.Add "hello", "world"
End
End Sub
Sub sub2()
Debug.Print D("hello")
End Sub
Sub test()
sub1
sub2 'call doesn't print anything
End Sub
确保您的代码中没有任何迷路End
。如果它不是End
则是其他内容。无论如何,VBA中对于在一个子中后期绑定公共对象变量并在另一个子中使用该绑定对象没有任何限制。
答案 1 :(得分:0)
itemdic
子时,这会照顾WaitforEmails
没有它的值。但是,我确实注意到当我到达第一个子itemdic
的末尾时,它具有正确的类型并具有值。我意识到当它返回到Userform的代码时,它在Watch窗口中显示(暂时)没有值并再次成为类型Object,这很奇怪,但我想这是因为每个窗口都在查看任何当前模块正在积极执行有意义的代码的范围。从Userform调用WaitforEmails
子代码后,代码将通过该子行itemdic
中的行正确显示值和类型字典。key
变量声明错误,应该声明为Variant
而不是Object
(doh!)