2016-04-29 3 views
0

Я написал приведенный ниже код, чтобы просмотреть все файлы в каталоге и скопировать определенные значения из них и вставить его обратно в главный файл.Файловый цикл ошибочно пропускает файлы

Проблема, с которой я столкнулась, заключается в том, что код никогда полностью не проходит через все файлы, и я никогда не получаю сообщение об ошибке.

Как показано на рисунке имена файлов изображены в виде 1 - #####, затем 2 - #### и т.д.

Иногда бывает множитель первого числа, как на картинке там являются двумя 1 - ### 's, но конечные числа все еще разные.

Проблема заключается в том, что вместо того, чтобы идти по фактическому порядковому номеру, код использует только первое число и переходит от 1, 10, 11, 100 и полностью пропускает остальные.

Любые идеи о том, как это решить?

Sub ReadDataFromCloseFile() 
    On Error GoTo ErrHandler 

    Application.EnableEvents = False 
    Application.ScreenUpdating = False 

    Dim FileType As String 
    Dim FilePath As String 

    FileType = "*.xlsm*" 'The file type to search for 
    FilePath = "\\filepath\" 'The folder to search 

    Dim src As Workbook 
    Dim OutputCol As Variant 
    Dim Curr_File As Variant 

    OutputCol = 9 'The first row of the active sheet to start writing to 

    Curr_File = Dir(FilePath & FileType) 

    Do Until Curr_File = "" 
    ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE". 
    Set src = Workbooks.Open(FilePath & Curr_File, True, True) 

    Sheets("Reporting").Range("I7:I750").Copy 

    Workbooks("Master.xlsm").Activate 
    Sheets("Sheet2").Select 
    Sheets("Sheet2").Cells(4, OutputCol).Select 
    ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
    Application.CutCopyMode = False 
    OutputCol = OutputCol + 1 

    ' CLOSE THE SOURCE FILE. 
    src.Close False    ' FALSE - DON'T SAVE THE SOURCE FILE. 
    Curr_File = Dir 
    Loop 
    Set src = Nothing 

    Application.EnableEvents = True 
    Application.ScreenUpdating = True 

    ErrHandler: 
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
End Sub 

Filepath

+0

Кроме того, петля фиксирует несколько 1 и 10 секунд. Он просто всегда пропускает что-либо с 2-9 в нем. –

+0

Вы пробовали это после комментирования 'on error'? На данный момент вы просто молча возвращаетесь, если что-то пойдет не так. –

+0

Да, я удалил эту часть из моего кода, но она по-прежнему не вызывает ошибок :( –

ответ

0

Я понятия не имею, почему он не открывает 2 до 9 файлов. Эта версия помещает все пути к файлам в коллекцию, а затем проходит через коллекцию. Она также делает прочь с выбором листов перед вставкой и т.д.

Sub ReadDataFromCloseFile() 

    Dim FileType As String 
    Dim FilePath As String 
    Dim colFiles As Collection 
    Dim src As Workbook 
    Dim tgt As Workbook 
    Dim OutputCol As Variant 
    Dim Curr_File As Variant 

    Set colFiles = New Collection 

    FileType = "*.xlsm*" 'The file type to search for 
    FilePath = "\\filepath\" 'The folder to search 

    EnumerateFiles FilePath, FileType, colFiles 

    OutputCol = 9 'The first row of the active sheet to start writing to 

    'If Master.xlsm is the book containing this code then use '=ThisWorkbook' 
    Set tgt = Workbooks("Master.xlsm") 

    For Each Curr_File In colFiles 
     Set src = Workbooks.Open(Curr_File, True, True) 

     src.Worksheets("Reporting").Range("I7:I750").Copy 
     tgt.Worksheets("Sheet2").Cells(4, OutputCol).PasteSpecial xlPasteValuesAndNumberFormats 
     OutputCol = OutputCol + 1 

     src.Close False 

    Next Curr_File 

End Sub 

Sub EnumerateFiles(ByVal sDirectory As String, _ 
    ByVal sFileSpec As String, _ 
    ByRef cCollection As Collection) 

    Dim sTemp As String 

    sTemp = Dir$(sDirectory & sFileSpec) 
    Do While Len(sTemp) > 0 
     cCollection.Add sDirectory & sTemp 
     sTemp = Dir$ 
    Loop 
End Sub 
+0

По какой-то причине это пропускает их, а также делает те же, что и раньше. Если я делаю это в папке, где файл имена являются регулярными 1,2,3,4,5, но это папка, которая имеет 1 - ####, 1 - ####, 2 - ###, это не так. –

+0

Мне удалось изменить это немного больше, а затем оно начало работать. Большое спасибо –

0

Это может быть проще для вас, чтобы перебрать файлы, используя следующую петлю.

Sub LoopFiles() 

Dim FSO As New FileSystemObject 
Dim Fldr As Folder 
Dim Fl As File 

'Loop through files in folder 
For Each Fl In FSO.GetFolder(filePath).Files 
    'Check for file type 
    If Fl.Type = "Excel Macro-Enabled Workbook" Then 
     'Open file & do procedure 
    End If 
Next 
Set FSO = Nothing 

End Sub 
+0

Я пробовал это, но он продолжает давать мне ошибку. Знаете ли вы, как включить код, который у меня был в этом? Я не знаю, как я может опубликовать то, что я пробовал изменить, поскольку я не могу отправлять код в комментариях. –

0

Попробуйте объявить переменную OutputCol как целое, а не вариант. Если вы знаете, что ваши данные всегда будут числом, никогда не рекомендуется использовать вариант. Для выполнения кода требуется больше ресурсов, и вы не знаете всей внутренней логики, которая происходит за кулисами. Это также дает вам больше контроля над выполнением кода и, вероятно, не даст вам головных болей, подобных этому. Используйте только вариант, если вы не знаете, какие данные вы собираетесь выводить.

Надеюсь, это поможет!

+0

Это должно помочь в производительности, но это не устраняет проблему пропуска. Я действительно ценю рекомендацию по производительности! –

+0

Я посмотрю на нее еще немного, и дайте знать, что я вижу. – Karlomanio

Смежные вопросы