поставить признак в таблицу

[Iskin]

Здравствуйте Гуру!
Исходные данные:
есть таблица "Адреса", есть запрос "All Запрос"
есть папка "pic", где лежат фотографии.
есть папка "pdf", где лежат документы.
есть код, который при загрузке 1.xls в таблицу "Адреса" в колонку F28 добавляет признак 1 (есть фото) или 0 (нет фото)

Option Compare Database
'обновление базы
Private Sub Кнопка0_Click()
DoCmd.Close acForm, "Каталог"
If Dir(CurrentProject.Path & "\1.xls") <> "" Then
CurrentDb.Execute "DELETE * FROM Адреса"
'Обнуление счетчика
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset("Адреса")
With rst
.AddNew
!КодАдреса = 0 ' - имя стчетчика
.Update
.MoveFirst
.Delete
End With
'
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Адреса", CurrentProject.Path & "\1.xls"
MsgBox "Успешное обновление базы!", vbOKOnly, "Сообщение"
DoCmd.Close

Else
  MsgBox "Файл обновления отсутствует в базе!", vbOKOnly, "Сообщение"
End If
' - поставить признак 1 для номеров где есть фото
Dim s As String
Dim i As Integer
Dim dbf As Database
Dim tdf As TableDef

Set dbf = CurrentDb
Set tdf = dbf.TableDefs("Адреса")

rst.MoveFirst
For i = 0 To rst.RecordCount - 1
  s = Dir(CurrentProject.Path & "\pic\" & rst.Fields("F1").Value & ".jpg")
  rst.Edit
  If s = "" Then
    rst.Fields("F28").Value = 0 '- F28 последняя колонка,
    'если добавлять новую колонку в общую базу, надо в таблице "Адреса" тоже добавить колонку
    'и в отчетах и формах тоже поменять на F28 и т.д.
  Else
    rst.Fields("F28").Value = 1 '- тут и в all запросе добавить колонки и в табл.Адреса
  End If
  rst.Update
  rst.MoveNext
Next i
rst.Close
'
DoCmd.OpenForm "Каталог", acNormal, "", "", , acNormal
End Sub

теперь я хочу чтобы в таблице "Адреса", в колонке F29 появился признак 0 или 1 и для pdf файлов.
Я скопировал код. поменял переменные s и i, соответственно поменял путь для pdf файлов, но что-то не получается. тут видимо думать надо . Помогите пожалуйста

[Eugene-LS]

Сообщение от Iskin

в колонке F29 появился признак 0 или 1 и для pdf файлов.

Попробуйте так:

Private Sub Кнопка0_Click()
Dim rst As Recordset
Dim sVal As String
    
    DoCmd.Close acForm, "Каталог"

    If Dir(CurrentProject.Path & "\1.xls") = "" Then
        MsgBox "Файл обновления отсутствует в базе!", vbOKOnly, "Сообщение"
        Exit Sub
    End If
    
'Зачистка
    CurrentDb.Execute "DELETE * FROM Адреса"
'Обнуление счетчика
    sVal = "ALTER TABLE Адреса ALTER COLUMN КодАдреса COUNTER(1,1)"
    CurrentDb.Execute sVal

'Импорт
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Адреса", CurrentProject.Path & "\1.xls"
    If DCount("*", "Адреса") > 0 Then
        MsgBox "Успешное обновление базы!", vbInformation, "Сообщение"
    Else
        MsgBox "Нет записей для проверки!", vbExclamation, "Сообщение !!!"
        Exit Sub
    End If
    
' DoCmd.Close ' Что Close ???

    Set rst = CurrentDb.OpenRecordset("Адреса")
    With rst
        Do Until .EOF = True 'Перебор всех записей в наборе
            rst.Edit ' - поставить признак 1 для номеров где есть фото
                sVal = CurrentProject.Path & "\pic\" & !F1 & ".jpg" 'Проверка картинки
                !F28 = (Dir(sVal, vbNormal) = "") + 1
    
                sVal = CurrentProject.Path & "\pdf\" & !F1 & ".pdf" 'Проверка PDF
                !F29 = (Dir(sVal, vbNormal) = "") + 1
            rst.Update
            .MoveNext
        Loop
    End With
    rst.Close
    
    DoCmd.OpenForm "Каталог", acNormal, "", "", , acNormal

End Sub

[Iskin]

Огромное спасибо!!!
Все работает. Только в 1.xls ошибка какая-то есть. признак 1 для PIC почему-то обрывается в таблице "Адреса". А для PDF все нормально. Буду разбираться.

[Iskin]

Выдает вот такое сообщение.

[Eugene-LS]

Сообщение от Iskin

Выдает вот такое сообщение.

Вы забыли примеры файлов выложить.
Без них не понять в чём дело.

Ошибка преобразования может возникать например когда вы пытаетесь вставить текст в числовое поле.

[Iskin]

Сообщение от Eugene-LS

Вы забыли примеры файлов выложить.
Без них не понять в чём дело.

Ошибка преобразования может возникать например когда вы пытаетесь вставить текст в числовое поле.

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

[Eugene-LS]

Сообщение от Iskin

Т.е. надо пересмотреть формат полей, начиная с тех строк, где этот признак обрывается?

Не знаю - не могу у вас исходный файл найти никак

Попробуйте импортировать так:

'Импорт
    sVal = "INSERT INTO Адреса SELECT * FROM [Лист1$] " & vbCrLf & _
            "IN '" & sSRCPath & "'[Excel 8.0; HDR=NO;]" & vbCrLf & _
            "WHERE ((Not F1='НомерDKD') AND (F1 Is Not Null));"
    CurrentDb.Execute sVal

' ...

У меня отработало без ошибок.