Module1からいくつかのサブスレッドを呼び出すフォームがあります。 Module1では、私は公に宣言されたオブジェクト変数を持っています。その変数のアイデアは、私の現在のvbaプロジェクトへの参照をあまりにも多く追加することを避けるために、遅いバインドされたscripting.dictionary
を作成することです。辞書は正常に作成され、Sub1に移入されます。しかし、Sub1が完了してSub2が呼び出されると、辞書変数が元のObject型に戻ります。実行時に1つのサブオブジェクトに変数があり、実行が次のサブオブジェクトに移動するときに内容が失われる
ログインフォーム:
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
のModule1:
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
私の質問:
は後期バインドさ辞書変数はその型を保つ持ってする方法はあります(とそのコンテンツ/値)を(モジュール1の)サブ参照に追加する必要はありませんか?
'itemdicのDebug.Printを追加します。最初のプロシージャの最後の実行可能ステートメントとして、また第2のプロシージャの最初の実行可能ステートメントとして、「comparemode」を使用します。4つの可能な結果があります(それぞれ2つのステートメントの成功/失敗)。どちらが問題になっているのかを知ることができます。 2つのサブルーチンの呼び出しの間に実行される他のコードでも可能です。 – MikeC
ネットワークの制約のため仕事用電子メールを自宅で設定することができないので、月曜日までデバッグするまで待つ必要があります。 – CaffeinatedCoder