Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
VBA переход к следующему действию если файла нет, VBA ошибка если файл отсутствует в папке
 
Добрый день.

Написал Макрос для сверки данных из двух источников, один формирует данные в одном фале, другой источник несколько.
Название файлов задается исходя из даты и других параметров. Короче, данные из разных источников собираются в одном общем файле и сверяются - это работает. Загвоздка в том, что из второго источника максиму должно быть 5 файлов, но может и меньше и когда макрос натыкается на то, что файла нет возникает ошибка. On error и  переход к следующему файлу работает только один раз в программе, через IF и номер ошибки тоже не получается. Как можно сделать, если одного, двух фалов нет, макрос переходил к следующему действию и заканчивался?

код не могу скинуть, писал на работе.  
 
Может есть возможность обнулить счетчик ошибок On Error и запустить его повторно?
 
RADLE,   Когда вы покажете хотя бы пример кода, думаю вам быстрее помогут

А пока попробуйте
Код
On Error Resume Next
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
В цикле:
Код
If Err = 0 Then
   ------------
 Else
    -----------
    Err.Clear
 End If
 
Resume next думаю не подойдёт, тк после открытия файла восполняются действия с ним филтраци, выделение нужных строк и перенос в общий файл. И если прописать resume next эти действия будут выполнять в активном таблице, нужен именно переход к следующему файлу и выполнения действий уже над ним, если он есть. Ок. В понедельник скину код  
 
Цитата
на то, что файла нет
А проверить наличие файла Dir не судьба?
 
Цитата
файла нет возникает ошибка
Проверяйте наличие файла в папке
Код
If Dir (iPath & FileName)="" Then
 
Или добавить  функцию проверки наличия файла и вызывать её.
 
Через IF Then пробовал как вы и написали. Я не особо понимаю как несколько раз приметь его, допустим 4 раза. Я прописывал его перед каждым открытием каждого файла и завершал end if, но он выходила ошибка что нет блока для end if. Т.е. Workbooks.Open Filename:= iFile1... далее действия над файлом, фильтрация, выделение необходимых данных, перенос в основную книгу, закрытие открытого файла.
Я написал код с телефона, но попросили исправить, тк с телефона не могу кинуть полноценный код, я его удалил. тогда в понедельник выложу. Спасибо.
Изменено: RADLE - 23 янв 2021 22:31:12
 
RADLE, вернитесь в своё сообщение и оформите код соответствующим тегом. И удалите кучу пустых строк.
 
Как пример. Почитайте комментарии

Код
Sub test()
    Dim iPath As String, FilenamesArray, i As Long, TempWorkbook As Workbook

    iPath = "C:\Temp\" 'слэш на конце
    FilenamesArray = Array("File1.xlsx", "File2.xlsx", "File3.xlsx") 'массив с названиями файлов
    'цикл по массиву с названиями файлов
    For i = LBound(FilenamesArray) To UBound(FilenamesArray)
        'проверяем наличие каждого файла в папке
        If Dir(iPath & FilenamesArray(i)) <> "" Then
            'ураа, файл есть, можем его открывать и работать с ним
            Set TempWorkbook = Workbooks.Open(iPath & FilenamesArray(i))
            'работаем с файлом как хотим
            'закрываем файл
            Workbooks(FilenamesArray(i)).Close SaveChanges:=True  'закрываем и сохраняем
        End If
    Next i
End Sub
Изменено: New - 25 янв 2021 17:48:57
 
Sub OTKR()

ddate = DateAdd("d", 0, Sheets("Menu").Cells(3, 3).Value)
ddate1 = ddate + 1
ddate2 = ddate + 2
ddate3 = ddate + 3
fDate = Format(ddate, "m\/d\/yyyy")

Dim ITK, IOK As String
Dim iLast As Long
Dim iName As String
Dim iName1 As String
Dim iName2 As String
Dim iName3 As String
Dim iName4 As String

ITK = ThisWorkbook.Name

sDay = Format(ddate, "dd")
sMonth = Format(ddate, "mm")
sYear = Format(ddate, "yyyy")
sDay1 = Format(ddate1, "dd")
sMonth1 = Format(ddate1, "mm")
sYear1 = Format(ddate1, "yyyy")
sDay2 = Format(ddate2, "dd")
sMonth2 = Format(ddate2, "mm")
sYear2 = Format(ddate2, "yyyy")

iYmd = sYear + sMonth + sDay
iYmd1 = sYear1 + sMonth1 + sDay1
iYmd2 = sYear2 + sMonth2 + sDay2

iName = "33_D" & iYmd & ".xlsx"
iName1 = "33_D" & iYmd1 & ".xlsx"
iName2 = "33_D" & iYmd2 & ".xlsx"
iName3 = "16_D" & iYmd1 & ".xlsx"
iName4 = "16_D" & iYmd2 & ".xlsx"

iPapka = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName
iPapka1 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName1
iPapka2 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName2
iPapka3 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName3
iPapka4 = "C:\Users\eabuzyarov\Desktop\Bank Reports\" & "*" & iName4
   
   indir = sDay + sMonth
   odir = "C:\Users\eabuzyarov\Desktop\d140\d140_" & indir & ".txt"
   IOK = Dir(odir)
   
   inp = Mid(odir, 4)
   inp2 = Right(inp, 13)
   Inp3 = Left(inp, 3)
   SSheet1 = Mid(ddate, 4)
   SSheet2 = Left(SSheet1, 2)
   
    With Application
      .ScreenUpdating = False
      .Visible = True
      .DisplayAlerts = False
  End With
   
   Workbooks.OpenText Filename:= _
       odir, Origin:=xlWindows, _
       StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
       ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
       , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
       
Columns("A:AQ").Select
Selection.AutoFilter
Selection.AutoFilter Field:=25, Criteria1:="<>0", Operator:=xlAnd
Selection.AutoFilter Field:=17, Criteria1:="<>*Direct*", Criteria2:="<>*cash*", Operator:=xlAnd

Range("Z2:Z1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Cells(LastRow, 1).Offset(1, 0).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("O2:O1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 1).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("Q2:Q1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 2).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("V2:V1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 3).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("AA2:AA1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 4).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("Y2:Y1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 5).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("AK2:AK1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 6).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("T2:T1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 7).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(IOK).Activate
Range("U2:U1000").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 8).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

lLastCol = Cells(LastRow + 1, Columns.Count).End(xlToLeft).Column
lLastRow = Cells(LastRow + 1, 3).End(xlDown).Row

ActiveWorkbook.Worksheets(SSheet2).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(SSheet2).Sort.SortFields.Add Key:=Range(Cells(LastRow + 1, 6), Cells(LastRow, 6)) _
       , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(SSheet2).Sort
       .SetRange Range(Cells(LastRow + 1, 1), Cells(lLastRow, 9))
       .Header = xlNo
       .MatchCase = True
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With

Windows(IOK).Activate
Windows(IOK).Close

Workbooks.OpenText Filename:= _
       iPapka1, Origin:=xlWindows, _
       StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
       ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
       , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
       
INK = Dir(iPapka)
INK1 = Dir(iPapka1)
INK2 = Dir(iPapka2)
INK3 = Dir(iPapka3)
INK4 = Dir(iPapka4)
             
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd

Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete

ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
       xlFilterValues, Criteria2:=Array(2, fDate)
       
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy

Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste
Windows(INK1).Activate

ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(LastRow + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK1).Activate
Windows(INK1).Close

iLast = Cells(Rows.Count, 11).End(xlUp).Row

Workbooks.OpenText Filename:= _
       iPapka2, Origin:=xlWindows, _
       StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
       ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
       , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd

Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete

ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
       xlFilterValues, Criteria2:=Array(2, fDate)
       
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy

Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK2).Activate

ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK2).Activate
Windows(INK2).Close

iLast = Cells(Rows.Count, 11).End(xlUp).Row

Workbooks.OpenText Filename:= _
       iPapka3, Origin:=xlWindows, _
       StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
       ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
       , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd

Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete

ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
       xlFilterValues, Criteria2:=Array(2, fDate)
       
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy

Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK3).Activate

ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK3).Activate
Windows(INK3).Close

iLast = Cells(Rows.Count, 11).End(xlUp).Row


Workbooks.OpenText Filename:= _
       iPapka4, Origin:=xlWindows, _
       StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
       ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
       , Space:=False, Other:=False, FieldInfo:=Array(1, 1)
Range("A3:K100").Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:=blanks, Operator:=xlAnd

Range("A4:K100").SpecialCells(xlCellTypeVisible).EntireRow.Delete

ActiveSheet.Range("$A$3:$K$41").AutoFilter Field:=3, Operator:= _
       xlFilterValues, Criteria2:=Array(2, fDate)
       
ActiveSheet.Range("$C$4:$C$100").Select
Selection.Copy

Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 10).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK4).Activate

ActiveSheet.Range("$F$4:$I$100").Select
Selection.Copy
Windows(ITK).Activate
Sheets(SSheet2).Select
Cells(iLast + 1, 1).Offset(0, 11).Select
'Cells(LastRow, 1).Offset(1, 0).Select
ActiveSheet.Paste

Windows(INK4).Activate
Windows(INK4).Close





End Sub
 
Как удалить сообщение и как правильно вставить в него код?
 
1. Удалять полностью свои сообщение на форуме нельзя (не предусмотрено форумом)
2. Свои сообщения можно редактировать. Для этого нажмите кнопку "Изменить" в правом нижнем углу вашего сообщения, которое вы хотите изменить
3. Код оформляется тегом Code. Для этого нужно выделить весь текст вашего кода и нажать на специальную кнопку <...> на панеле над вашем текстом. См. картинку
Снимок.JPG (17.56 КБ)
Изменено: New - 25 янв 2021 17:54:08
 
Код оформляйте с помощью кнопки <...>
А лучше прикрепите небольшой пример с макросом, по которому у Вас вопрос. Вряд ли кому-то охота копаться в Вашей простыне
Страницы: 1
Читают тему (гостей: 3)
Наверх