Пропустить открытый файл

Question

У меня есть код ниже, который открывает каждый файл .xlsx в папке и вызывает другую подпрограмму к нему.Когда он достигает открытого файла (его неизбежно из-за предшествующих подпрограмм), мне нужно пропустить этот файл и продолжить.Это было изменено из онлайн-источника, так как я не полностью понимаю, используя пути.Заранее спасибо!

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

Answer 1

В итоге я сделал сохранение в новом (не .xlsx) формате и убил исходный файл.Я использовал .xlsm, чтобы сохранить оригинальное форматирование, но .csv также работал.Это происходит из загруженного отчета, поэтому получение новой копии убитого оригинала не сложно, если мне это нужно.Первый шаг всего моего модуля выглядит следующим образом:

'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

Answer 2

Это должно работать.Пока файл, содержащий этот код, сохраняется как * .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

Answer 3

Сначала проверьте статус книги:

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

Если после открытия ReadOnly статус True, то, вероятно, можно предположить, что книга уже была открыта в другом месте, прежде чем вы открыли ее в коде.

Это немного грязно, но сработает для твоих целей.

Answer 4

Предположительно файл, содержащий этот код, сохраняется как .xlsm (а не .xlsx), что означает, что файл будет пропущен, так как код ищет только файлы, сохраненные как .xlsx

Если файл сохраненкак .xlsx, вы можете проверить, соответствует ли открываемый файл имени файла текущего файла, только запустите код, если имена отличаются.Смотрите пример кода ниже.Операторы MsgBox только для целей тестирования, удалите их в окончательном коде.

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