CODEWITHSUNDEEP
excelvba
TKE-439
TKE-439

Reputation: 87

Skip the open file

I have the code below that opens each .xlsx file in a folder and calls another sub to it. When it reaches the file that is open (unavoidable to have it open due to preceding subs), I need this to skip this file and continue. This was modified from an online source as I don't fully comprehend using paths. Thanks in advance!

Sub OpenFilesVBA()
    Dim Wb As Workbook
    Dim strFolder As String
    Dim strFil As String

    Application.ScreenUpdating = False

    strFolder = Application.ActiveWorkbook.path
    strFil = Dir(strFolder & "\*.xlsx*")
    Do While strFil <> vbNullString
        Set Wb = Workbooks.Open(strFolder & "\" & strFil)
'===========Run Objective Macro==========================================
        Call PoG_Report_Prep
'========================================================================
        ActiveWorkbook.Save
        Wb.Close False
        strFil = Dir
    Loop
End Sub

Upvotes: 0

Views: 504

Answers (4)

MatAff
MatAff

Reputation: 1331

Presumably the file containing this code is saved as .xlsm (rather than .xlsx), which means the file will be skipped as the code only looks for files saved as .xlsx

If the file is saved as .xlsx you could check whether the file being opened matches the filename of the current file only run the code if the names are different. See example code below. MsgBox statements for testing purposes only, remove these in the final code. 

Sub OpenFilesVBA()
    Dim Wb As Workbook
    Dim strFolder As String
    Dim strFil As String
    Dim strActiveFil As String '

    Application.ScreenUpdating = False

    strFolder = Application.ActiveWorkbook.Path
    strActiveFil = Application.ActiveWorkbook.Name
    strFil = Dir(strFolder & "\*.xlsx*")
    Do While strFil <> vbNullString
        MsgBox strFil
        If strFil <> strActiveFil Then
            MsgBox "run" '
            Set Wb = Workbooks.Open(strFolder & "\" & strFil)
'===========Run Objective Macro==========================================
            'Call PoG_Report_Prep
'========================================================================
            ActiveWorkbook.Save
            Wb.Close False
            strFil = Dir
        Else
            MsgBox "not run"
            strFil = Dir
        End If
    Loop
End Sub

Upvotes: 1

TKE-439
TKE-439

Reputation: 87

I ended up doing a save as in a new (non-.xlsx) format and killing the original file. I used .xlsm to keep the original formatting, but .csv worked also. This comes from a report that is downloaded, so getting a new copy of the killed original isn't difficult should I need it. The first step of my entire module is as follows:

'OF = Original File
Dim strFullName As String, OF As String, CurrentWB As Workbook
Set CurrentWB = ActiveWorkbook
strFullName = CurrentWB.path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & 
".xlsm"

OF = Application.ActiveWorkbook.FullName
ActiveWorkbook.SaveAs Filename:=strFullName, 
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

'' Delete Original File
Kill OF

Upvotes: 1

SierraOscar
SierraOscar

Reputation: 17637

Check the status of the workbook first:

Set Wb = Workbooks.Open(strFolder & "\" & strFil)
If Not Wb.ReadOnly Then '// workbook is readonly
    PoG_Report_Prep
    Wb.Save
End If

Wb.Close
Set Wb = Nothing

If the ReadOnly status after opening is True then we can probably assume that the workbook was already open elsewhere before you opened it in code.

It's a bit dirty, but would work for your purpose.

Upvotes: 0

IAmNerd2000
IAmNerd2000

Reputation: 771

This should work. As long as the file that contains this code is saved as *.xlsm

Option Explicit

Sub OpenFilesVBA()
    Dim Wb As Workbook
    Dim strFolder As String
    Dim strFil As String
    Dim fso As Object
    Dim fil As Object
    Dim fldr As Object

    Application.ScreenUpdating = False

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fldr = fso.GetFolder(Application.ActiveWorkbook.Path)

    For Each fil In fldr.Files
        If LCase(fso.GetExtensionName(fil.Path)) = "xlsx" Then
            Set Wb = Workbooks.Open(fil.Path)
'===========Run Objective Macro==========================================
            Call PoG_Report_Prep
'========================================================================
            ActiveWorkbook.Save
            Wb.Close False
            Set Wb = Nothing
        End If
    Next

    Set fil = Nothing
    Set fldr = Nothing
    Set fso = Nothing

    Application.ScreenUpdating = True

End Sub

Upvotes: 0

Related Questions