Home > Software design >  Getting the macro to look for a needed file before running code
Getting the macro to look for a needed file before running code

Time:08-11

Could someone please suggest a good way to insert code that looks for the needed reference file before running code? If file is not open, the code will not run. Thank you.

Currently, my code will just error out with some of the code running if the file is not found.

something like...

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

CodePudding user response:

Quick example for checking if any wb has been found:

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."

CodePudding user response:

If I got the OP right he would like to check if a certain workbook is already open in Excel. And in case it is open some code can run then.

My suggestion would be to do it like that

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

The following code will be needed for the code above

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 Long, xlApp As Excel.Application) As Boolean
        Dim hWinDesk As Long, hWin7 As Long
        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 Long
        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
  • Related