excel 运行代码前查找打开的文件

tcomlyy6  于 2022-12-14  发布在  其他
关注(0)|答案(2)|浏览(221)

我想在运行代码之前查找所需的引用文件。
如果找不到该文件,我的代码将出错,其中一些代码正在运行。
比如...

Sub TestByWorkbookName()
    Dim wb As Workbook

    For Each wb In Workbooks
        If wb.Name = "file name" Then
         
            'run code...
    
        End If
        
    Next
    
    MsgBox "File not found"
End Sub

我想运行代码,如果工作簿是打开的和结束子,如果没有打开。

z9smfwbn

z9smfwbn1#

检查是否找到任何wb的快速示例:

for each wb in workbooks
    if instr(wb.name, "file name")>0 then
        check = 1
        `do stuff
        exit sub
    else
        check = 0
    end if
next wb
if check = 0 then msgbox "File not found."
3bygqnnd

3bygqnnd2#

如果我的操作是正确的,他会检查某个工作簿是否已经在Excel中打开。如果它是打开的,那么一些代码可以运行。
我的建议是那样做

Sub RunCode()

    Dim wkbName As String
    wkbName = "myWorkbook.xlsx"     ' only the workbook name is needed, not the full path

    If isWorkbookOpen(wkbName) Then   ' code for this function is below
        ' Run the code you want to run in case the workbook with the name wkbName is open
        Debug.Print wkbName & " is open"
    
    Else
        ' Do not do anything in case the workbook with the name wkbName is not open
        Debug.Print wkbName & " is not open"
    End If

End Sub

上面的代码需要以下代码

Option Explicit
        
    
Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, _
    ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" _
    (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" _
    (ByVal hWnd As LongPtr, ByVal dwId As Long, ByRef riid As GUID, _
    ByRef ppvObject As Object) As LongPtr
         
             
    Private Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(7) As Byte
    End Type
    
    Private Const S_OK As Long = &H0
    Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
    Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0
    
    Function getXLApp(hWinXL As LongPtr, xlApp As Excel.Application) As Boolean
        Dim hWinDesk As LongPtr, hWin7 As LongPtr
        Dim obj As Object
        Dim iid As GUID
        
        Call IIDFromString(StrPtr(IID_IDispatch), iid)
        hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
        hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
        
        If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
            Set xlApp = obj.Application
            getXLApp = True
        End If
    
    End Function
    
    Function isWorkbookOpen(wkbName As String) As Boolean
        
        Dim hWinXL As LongPtr
        hWinXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
        
        Dim xlApp As Excel.Application
        Dim wb As Excel.Workbook
        
        Do While hWinXL > 0
                    
            If getXLApp(hWinXL, xlApp) Then
                For Each wb In xlApp.Workbooks
                    If wb.Name = wkbName Then
                        isWorkbookOpen = True
                    End If
                Next
            End If
            hWinXL = FindWindowEx(0, hWinXL, "XLMAIN", vbNullString)
        Loop
        
    End Function

相关问题