2016-04-16 12 views
1

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の)サブ参照に追加する必要はありませんか?

+0

'itemdicのDebug.Printを追加します。最初のプロシージャの最後の実行可能ステートメントとして、また第2のプロシージャの最初の実行可能ステートメントとして、「comparemode」を使用します。4つの可能な結果があります(それぞれ2つのステートメントの成功/失敗)。どちらが問題になっているのかを知ることができます。 2つのサブルーチンの呼び出しの間に実行される他のコードでも可能です。 – MikeC

+0

ネットワークの制約のため仕事用電子メールを自宅で設定することができないので、月曜日までデバッグするまで待つ必要があります。 – CaffeinatedCoder

答えて

0

うわー、私は本当のバカのように感じる。問題は、全体的に、少なくとも部分的には、私の顔を見ている。私は、問題は2方面からだったと思います:

  1. 「掃除」するために必要なプロジェクト(モジュールとフォームをエクスポートし、新しいプロジェクトにそれらをインポート)
    • これは持っていないitemdicの世話をしましたそれはWaitforEmailsサブに到着したときの値です。しかし、私は最初のサブitemdicの終わりに達すると、正しいタイプと値を持っていることに気付きました。私が気付いたのは、ウォッチウィンドウに(値がない)Objectオブジェクトのコードに戻ったときです。もう一度タイプオブジェクトになりました。これは奇妙ですが、それぞれのウィンドウが現在のモジュールが有効に実行しているコードの範囲。 WaitforEmails subがUserformから呼び出され、コードがそのサブitemdicの行を通過すると、値が正しく表示され、辞書型として表示されます。私は、辞書内の項目をループに使用
  2. key変数が間違っていると宣言され、それがVariantないObjectとして宣言されなければならない(DOH!)
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

公共のオブジェクトにこのような制限がないことを聞いてうれしいニュースです。私はSub1に 'End'コールを持っていません。私が持っている唯一のものは、エラートラップの前に標準の「Exit Sub」です。それが原因だろうか?また、私はUserFormのサブとして 'test()'を使ったと仮定していますか? – CaffeinatedCoder

+1

私は分かりません。私はちょうど私のサブの 'End'を' Exit Sub'に置き換えて問題はなかった。私もエラーハンドラを追加し、意図的にそれを引き起こし、問題はなかった。それを全体的に投稿できる十分小さな再現可能な問題にすることはできますか? –

+0

確かに、少し質問を更新します – CaffeinatedCoder

関連する問題