簡體   English   中英

嘗試在打開工作簿后關閉它,但循環無法執行此操作

[英]trying to close a workbook after it gets opened, but the loop failes to do it

通過一個子我從一個網站下載一個 excel 文件。 單擊下載按鈕時,它會打開 excel 文件並下載文件。 我不需要打開它,所以一旦它打開並且在下一個潛艇開始之前,我需要關閉它。 通過一些代碼,我試圖做到這一點,但我失敗了。

問題是我編寫的 Do Loop 無法捕獲文件並掛起。 當我通過 F8 調試它時,它運行良好。 然后我想也許通過 application.wait 方法我可以讓 sub 等到工作簿出現,就像在調試模式下發生的那樣,但它也沒有幫助。

我還需要補充一點,因為每次下載文件時,網站都會更改其名稱,然后我使用 Like 運算符。

Sub Test()    
    Dim wb As Workbook
    Dim wbName As String
    Dim Cnt As Integer
    
    wbName = "transactions_history_"
    
    'Application.Wait Now + TimeValue("00:00:10") ' it didnt help so i commented it
    Do
        Application.Wait Now + TimeValue("00:00:01")
        For Each wb In Application.Workbooks
            If wb.Name Like wbName & "*" Then
                Cnt = 1
                Exit Do
            End If
        Next wb
    Loop Until Cnt = 1 
    wb.Close
End Sub

有人有什么想法嗎? 謝謝。

FaneDuru,我在這里復制從網站下載工作簿的代碼。 它工作得很好,直到網站改變了一些東西,當文件被下載時,它也被打開了。 我需要關閉它以讓程序的 rest 正常工作,但到目前為止我無法管理它。

Sub TBC()

    ' declerations
    Dim myBrowser                             As Selenium.ChromeDriver
    Dim FindBy                                As New Selenium.by
    Dim objFSO                                As Object
    Dim objFolder                             As Object
    Dim objFile                               As Object
    Dim A, I                                  As Integer
    Dim FileName, BankFolderAddress           As String
    Dim N                                     As Byte
  
    ' initializations
    BankFolderAddress = "D:\Projects\Excel\Main Program\Bank Statements\"
    Set FindBy = New Selenium.by
    Set myBrowser = New WebDriver
    I = 0
    A = 0
        
    Sheet2.Cells.ClearContents
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(BankFolderAddress)
    For Each objFile In objFolder.Files 
        Sheet2.Cells(I + 1, 1) = objFile.Name
        Sheet2.Cells(I + 1, 2) = objFile.Path
        I = I + 1
    Next objFile
    If Sheet2.Cells(1, 1) <> "" Then
        For N = 1 To I
            Kill Sheet2.Cells(N, 2).value
        Next N
    End If
   
Start:
   
    myBrowser.SetProfile Environ("LOCALAPPDATA") & "\GOOGLE\CHROME\USER DATA"
    myBrowser.AddArgument "profile-directory=Default"
    myBrowser.Start "chrome"
    
    Application.DisplayAlerts = False
   
    
   'Address e website
    myBrowser.Get "https://tbconline.ge/tbcrd/login?t=false"
    myBrowser.Window.Maximize
    
    A = 0
    Do
        Application.Wait Now + TimeValue("00:00:01")
        A = A + 1
        If A = 10 Then GoTo Finish
    Loop Until myBrowser.IsElementPresent(FindBy.XPath("//button"))
      
    If myBrowser.IsElementPresent(FindBy.Css("input[formcontrolname='username']")) Then
        myBrowser.FindElementByXPath("//button").Click
    Else
        GoTo JMP
    End If

JMP:
   
   'For removing PopUps
    If myBrowser.IsElementPresent(FindBy.XPath("//div[@id='mainLoadingLayer']/ui-view/ui-view/div/div[2]/div/div/div/div/div[3]/button")) Then
        myBrowser.FindElementByXPath("//div[@id='mainLoadingLayer']/ui-view/ui-view/div/div[2]/div/div/div/div/div[3]/button").Click
    End If
   
   ' Choosing Transaction Menu
    A = 0
    Do
        Application.Wait Now + TimeValue("00:00:01")
        A = A + 1
        If A = 10 Then GoTo Finish
    Loop Until myBrowser.IsElementPresent(FindBy.XPath("//a[contains(text(),'Transactions')]"))

    If myBrowser.IsElementPresent(FindBy.XPath("//a[contains(text(),'Transactions')]")) Then
        myBrowser.FindElementByXPath("//a[contains(text(),'Transactions')]").Click
    End If

   'choosing Transaction submenu
    A = 0
    Do
        Application.Wait Now + TimeValue("00:00:01")
        A = A + 1
        If A = 10 Then GoTo Finish
    Loop Until myBrowser.IsElementPresent(FindBy.XPath("//span[contains(.,'Transactions')]"))

    If myBrowser.IsElementPresent(FindBy.XPath("//span[contains(.,'Transactions')]")) Then
        myBrowser.FindElementByXPath("//span[contains(.,'Transactions')]").Click
    End If
                
   'Clicking on Download icon
    Do
        Application.Wait Now + TimeValue("00:00:01")
    Loop Until myBrowser.IsElementPresent(FindBy.XPath("//ib-controls/div/div[2]/div[2]"))

    If myBrowser.IsElementPresent(FindBy.XPath("//ib-controls/div/div[2]/div[2]")) Then
        myBrowser.FindElementByXPath("//ib-controls/div/div[2]/div[2]").Click
    End If
              
   ' clicking on excel option to download it
    Do
        Application.Wait Now + TimeValue("00:00:01")
    Loop Until myBrowser.IsElementPresent(FindBy.XPath("//a[contains(.,'Excel')]"))

    If myBrowser.IsElementPresent(FindBy.XPath("//a[contains(.,'Excel')]")) Then
        myBrowser.FindElementByXPath("//a[contains(.,'Excel')]").Click
    End If
              
             
   'checking if the file is downloaded
    Do
        Application.Wait Now + TimeValue("00:00:02") 
    Loop Until Dir(BankFolderAddress & "transactions_history_*.xlsx") <> ""
  
   ' get the file name
    FileName = Dir(BankFolderAddress & "transactions_history_*.xlsx", vbDirectory)
    
   ' check if the downloaded file size
    Do
        Application.Wait Now + TimeValue("00:00:05") '03 bood
    Loop Until FileLen(BankFolderAddress & FileName) > 10000
  
Finish:
  
    ' close the Browser
    myBrowser.close

    ' ## I added this code to close the workbook but failed  
    ' call Test()
    
    Dim wb As Workbook
    Dim wbName As String
    Dim Cnt As Integer

wbName = FileName

Do
    Application.Wait Now + TimeValue("00:00:01")
    For Each wb In Application.Workbooks
        If wb.Name=FileName Then
            Cnt = 1
            wb.Close
            Exit Do
        End If
    Next wb
Loop Until Cnt = 1

call BankDataExtraction()    

結束子

問題是,如果我在調試模式下沒有在循環之前停止子,下載的工作簿既不會出現在屏幕上,也不會出現在任務管理器中,並且循環無法捕獲並關閉它,它就會掛起。 等待方法也無濟於事。 我嘗試了你的代碼,但它給了我自動化錯誤無效的語法,同時執行 Set sessEx = GetObject(wbFullName).Application 我將完整的文件地址傳遞給它,If Not sameExSession(FileName)。

如果您確定wbName是要搜索的工作簿的名稱,則您的代碼必須執行您需要的操作,但前提是討論中的工作簿在相同 EXCEL SESSION 中打開 我詢問了打開它的代碼,但沒有收到任何澄清。 請使用下一個 function 檢查工作簿是否在同一個 session 中打開(工作簿保留檢查代碼)。 如果它的第二個參數是True ,它會關閉工作簿,即使在不同的 session 中並退出 session。 Many codes searches for an existing Excel session and use it, but open a new session if no such a session has been found. 其他,使用新的 session:

Function sameExSession(wbFullName As String, Optional boolClose As Boolean) As Boolean
   Dim sessEx As Excel.Application, wb As Workbook
  
   Set sessEx = GetObject(wbFullName).Application
   If sessEx.hwnd = Application.hwnd Then
        sameExSession = True
   Else
        sameExSession = False
        If boolClose Then
            sessEx.Workbooks(Right(wbFullName, Len(wbFullName) - InStrRev(wbFullName, "\"))).Close False
            sessEx.Quit: Set sessEx = Nothing
        End If
   End If
End Function

可以通過以下方式從您現有的代碼中調用它:

Sub Test()    
    Dim wb As Workbook, wbName As String, Cnt As Integer
    
    wbName = "transactions_history_"
    If Not sameExSession Then Exit Sub 'take care to use the workbook FULL NAME!
    Do
        Application.Wait Now + TimeValue("00:00:01")
        For Each wb In Application.Workbooks
            If wb.Name Like wbName & "*" Then
                Cnt = 1
                Exit Do
            End If
        Next wb
    Loop Until Cnt = 1 
    wb.Close
End Sub

如果您不知道工作簿擴展名(因為您沒有在上面的代碼中使用它),您可以使用以下方法獲取工作簿名稱:

    Dim strFullName As String, foldName As String
    foldName = "path to the folder where the workbook is downloaded"
    strFullName = dir(foldName & "\" & vbname & "*.*")
    If strFullName <> "" Then
       If Not sameExSession Then Exit Sub
    Else
        MsgBox "Strange...": Stop 'Just in case. It must be found, if foldName and vbName are correct...
    End If

如果在同一個文件夾中有多個這樣的工作簿,其名稱包含使用的字符串,則它可能會失敗。 它將按字母順序返回其中的第一個。 但是,如果出現這種情況,您是需要澄清的人......當然,如果在其他 session 中打開是正確的假設。 在這種情況下,一段代碼可以在所有名稱中具有相同字符串的工作簿之間進行迭代,以確定最后保存的工作簿。

您可以確定這方面(其他會話),手動搜索工作簿,復制其全名並創建一個測試Sub ,它只調用我提供的 function,使用確定的全名。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM