一个子中的后期绑定公共对象变量,并且当执行移动到下一个子时丢失内容

时间:2016-04-16 14:49:30

标签: excel vba excel-vba dictionary

我有一个表单,它调用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中)而不必添加引用?

2 个答案:

答案 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)

哇,所以我觉得自己像个真正的白痴。这个问题一直在面对我,至少部分是这样。我认为这个问题是双管齐下的:

  1. 项目需要“清理”(导出模块和表单并将它们导入新项目)
    • 当到达itemdic子时,这会照顾WaitforEmails没有它的值。但是,我确实注意到当我到达第一个子itemdic的末尾时,它具有正确的类型并具有值。我意识到当它返回到Userform的代码时,它在Watch窗口中显示(暂时)没有值并再次成为类型Object,这很奇怪,但我想这是因为每个窗口都在查看任何当前模块正在积极执行有意义的代码的范围。从Userform调用WaitforEmails子代码后,代码将通过该子行itemdic中的行正确显示值和类型字典。
  2. 我用来遍历字典中项目的key变量声明错误,应该声明为Variant而不是Object(doh!)