Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Access Новый топик    Ответить
Топик располагается на нескольких страницах: Ctrl  назад   1 2 3 [4]      все
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург,
Да могу, все без проблем
30 янв 20, 14:55    [22069595]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург,
Если изменить на dbOpenTable, то ругается на эту строчку
Set rst = CurrentDb.OpenRecordset("tblAttachedFiles", dbOpenTable)
30 янв 20, 15:16    [22069616]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4620
RusGor
Если изменить на dbOpenTable, то ругается на эту строчку
Set rst = CurrentDb.OpenRecordset("tblAttachedFiles", dbOpenTable)
Мне кажется выше тебе написали что там должно быть
30 янв 20, 15:31    [22069641]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург,

Да видел, исправил на dbOpenSnapshot

Так на всякий случай
30 янв 20, 15:33    [22069642]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург,
Что еще может быть, есть идеи?
30 янв 20, 18:17    [22069782]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4620
RusGor
Что еще может быть, есть идеи?
Код свой покажи, тот что вызывает ошибку. Полностью процедуру (или чего там у тебя).
31 янв 20, 04:29    [22070087]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург, день добрый!
Private Sub cmdFileAdd_Click()
Dim dlgOpenFile As Object 'FileDialog
Dim strFileName As String, strFileNameNew As String
Dim rst As DAO.Recordset

'On Error Resume Next
strFileName = CurrentProject.Path & "\Files\"
    If Len(Dir$(strFileName, vbDirectory)) = 0 Then MkDir strFileName
Set dlgOpenFile = Application.FileDialog(1&) 'msoFileDialogOpen
    With dlgOpenFile
        .InitialFileName = CurrentProject.Path
        .AllowMultiSelect = False
        .Title = "Укажите прикрепляемый файл"
            If .Show = -1 Then
                strFileName = .SelectedItems(1)
                Set rst = CurrentDb.OpenRecordset("tblattachedfiles", dbOpenSnapshot)
                    With rst
                        .AddNew
                        .Fields(1) = Me.DocID
                        .Fields(2) = Mid(strFileName, InStrRev(strFileName, "\") + 1)
                        .Fields(3) = (Me.Text_ + "_") & CStr(.Fields(1)) & "_" & CStr(.Fields(0)) & Mid(.Fields(2), InStrRev(.Fields(2), "."))
                        .Update
                        .Bookmark = .LastModified
                        strFileNameNew = CurrentProject.Path & "\Files\" & .Fields(3)
                    End With
                FileCopy strFileName, strFileNameNew
                    If Err Then
                        Err.Clear
                        rst.Delete
                        MsgBox "Ooopps!..." & vbNewLine & "Не смогли прикрепить файл!", vbCritical
                    Else
                            With Me.lstFileName
                                .Requery
                                .Value = rst.Fields(0)
                            End With
                        lstFileName_Click
                    End If
                rst.Close
            Else
                MsgBox "А что отказались?", vbInformation
            End If
    End With
Set rst = Nothing
Set dlgOpenFile = Nothing
End Sub


К сообщению приложен файл. Размер - 12Kb
2 фев 20, 17:38    [22071171]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4620
RusGor, вроде ничего криминального не вижу. Протестировать мне не на чем, т.к. нет сервера MySQL.
Давай попробуем протестировать получение набора данных на другой технологии - ADO. Таким способом можно получить характеристики набора данных. Заведи новую БД Access (подключи таблицы) или создай в текущей новый модуль, подключи библиотеку доступа к данным ADO, добавь код. Код взят у Гетца&Ко
+
Public Sub TestRecordsets()
    Dim rst As ADODB.Recordset
    
    Set rst = New ADODB.Recordset
    
    rst.Open "tblattachedfiles", CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdTableDirect
    Debug.Print "======================="
    RecordsetSupport rst
    rst.Close
    Set rst = Nothing
End Sub

Private Sub RecordsetSupport(rst As ADODB.Recordset)
    If rst.Supports(adAddNew) Then
        Debug.Print "Supports AddNew"
    Else
        Debug.Print "Doesn't support AddNew"
    End If
    If rst.Supports(adApproxPosition) Then
        Debug.Print "Supports AbsolutePosition"
    Else
        Debug.Print "Doesn't support AbsolutePosition"
    End If
    If rst.Supports(adBookmark) Then
        Debug.Print "Supports bookmarks"
    Else
        Debug.Print "Doesn't support bookmarks"
    End If
    If rst.Supports(adDelete) Then
        Debug.Print "Supports Delete"
    Else
        Debug.Print "Doesn't support Delete"
    End If
    If rst.Supports(adFind) Then
        Debug.Print "Supports Find"
    Else
        Debug.Print "Doesn't support Find"
    End If
    If rst.Supports(adHoldRecords) Then
        Debug.Print "Supports move without save"
    Else
        Debug.Print "Doesn't support move without save"
    End If
    If rst.Supports(adIndex) Then
        Debug.Print "Supports Index"
    Else
        Debug.Print "Doesn't support Index"
    End If
    If rst.Supports(adMovePrevious) Then
        Debug.Print "Supports MovePrevious"
    Else
        Debug.Print "Doesn't support MovePrevious"
    End If
    If rst.Supports(adResync) Then
        Debug.Print "Supports Resync"
    Else
        Debug.Print "Doesn't support Resync"
    End If
    If rst.Supports(adSeek) Then
        Debug.Print "Supports Seek"
    Else
        Debug.Print "Doesn't support Seek"
    End If
    If rst.Supports(adUpdate) Then
        Debug.Print "Supports Update"
    Else
        Debug.Print "Doesn't support Update"
    End If
    If rst.Supports(adUpdateBatch) Then
        Debug.Print "Supports UpdateBatch"
    Else
        Debug.Print "Doesn't support UpdateBatch"
    End If
End Sub

Запускаем TestRecordsets и смотрим результат в окне Immediate.

Сообщение было отредактировано: 3 фев 20, 04:45
3 фев 20, 04:44    [22071387]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
vmag
Member

Откуда: MP
Сообщений: 3457
RusGor,

Вроде и нельзя сказать, что не показал код ошибки, но и толку с такого показа маловато...
Нужно было еще нажать Debug, тогда бы было ясно на какой строке падает, тогда бы возможно и сам понял причину...
3 фев 20, 11:40    [22071573]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург, доброе утро!

Вот что выдает.

=======================
Supports AddNew
Doesn't support AbsolutePosition
Supports bookmarks
Supports Delete
Supports Find
Supports move without save
Doesn't support Index
Supports MovePrevious
Doesn't support Resync
Doesn't support Seek
Supports Update
Supports UpdateBatch
3 фев 20, 11:54    [22071584]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
vmag
RusGor,

Нужно было еще нажать Debug.

Выше писал что ругается на .AddNew

Вот тут .Fields(3) = (Me.Text_ + "_") & CStr(.Fields(1)) & "_" & CStr(.Fields(0)) & Mid(.Fields(2), InStrRev(.Fields(2), "."))

Тут пишет что текущая запись отсутствует CStr(.Fields(1)) и тут CStr(.Fields(0))

.LastModified -операция не поддерживается для объектов данного типа
3 фев 20, 12:01    [22071600]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург,

В этом может причина?
https://docs.microsoft.com/ru-ru/office/client-developer/access/desktop-database-reference/recordset-absoluteposition-property-dao
3 фев 20, 12:06    [22071604]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4620
RusGor
=======================
Supports AddNew
Doesn't support AbsolutePosition
Supports bookmarks
Supports Delete
Supports Find
Supports move without save
Doesn't support Index
Supports MovePrevious
Doesn't support Resync
Doesn't support Seek
Supports Update
Supports UpdateBatch
добавление данных источник поддерживает...
3 фев 20, 12:37    [22071624]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4620
RusGor
В этом может причина?
это к чему?
3 фев 20, 12:37    [22071626]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург,
Все взрыв мозга...
3 фев 20, 12:48    [22071640]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург
это к чему?
к этому AbsolutePosition
3 фев 20, 12:50    [22071642]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4620
RusGor
Set rst = CurrentDb.OpenRecordset("tblattachedfiles", dbOpenDynaset)
попробуй так переписать...


RusGor
.Fields(3) = (Me.Text_ + "_") & CStr(.Fields(1)) & "_" & CStr(.Fields(0)) & Mid(.Fields(2), InStrRev(.Fields(2), "."))
тут возможно будет ошибка (проблема при работе MySQL, см. ссылку ниже). Попробуй переписать на ADO.

vmag,у тебя же проблемы вылазили с MySQL DAO + ODBC + MySql получение ключа-счетчика в момент создания записи Как решилось?

Сообщение было отредактировано: 3 фев 20, 12:58
3 фев 20, 12:53    [22071646]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4620
RusGor
к этому AbsolutePosition
А что не так с этим свойством?
3 фев 20, 12:54    [22071648]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург,

RusGor
.Fields(0)


Именно тут. Выдает NULL
3 фев 20, 13:30    [22071704]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург,

Не обращайте внимание.
3 фев 20, 13:31    [22071709]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
vmag
Member

Откуда: MP
Сообщений: 3457
Панург
vmag,у тебя же проблемы вылазили с MySQL DAO + ODBC + MySql получение ключа-счетчика в момент создания записи Как решилось?

Для DAO:
- запрос с сортировкой по ключу (чтоб последний был всегда последним)
- после добавления Requery + MoveLast
Все остальное не работает...
3 фев 20, 13:41    [22071721]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
RusGor
Member

Откуда:
Сообщений: 27
Панург и vmag, здравствуйте!
Спасибо, что направили на путь истинный.
Панург
Set rst = CurrentDb.OpenRecordset("tblattachedfiles", dbOpenDynaset)


RusGor
.Fields(0) 
Индекс (на.. он мне нужен) только для уникальности имени файла.

vmag
- после добавления Requery + MoveLast


Вот итог: не знаю на сколько верно, но работает. Может подскажите что исправить,.?
Private Sub cmdFileAdd_Click()
Dim dlgOpenFile As Object 'FileDialog
Dim strFileName As String, strFileNameNew As String
Dim rst As DAO.Recordset

On Error Resume Next
strFileName = CurrentProject.Path & "\Files\"
    If Len(Dir$(strFileName, vbDirectory)) = 0 Then MkDir strFileName
Set dlgOpenFile = Application.FileDialog(1&) 'msoFileDialogOpen
    With dlgOpenFile
        .InitialFileName = CurrentProject.Path
        .AllowMultiSelect = False
        .Title = "Укажите прикрепляемый файл"
            If .Show = -1 Then
                strFileName = .SelectedItems(1)
                Set rst = CurrentDb.OpenRecordset("tblattachedfiles", dbOpenDynaset)
                    With rst
                        .AddNew
                        .Fields(1) = Me.DocID
                        .Fields(2) = (Me.Text_ + "_") & Format(Now(), "dd.mm.yyyy.hh.nn.ss") & Mid(strFileName, InStrRev(strFileName, "."))
                        .Fields(3) = 0
                        .Update
                        .Bookmark = .LastModified
                        .Requery
                        .MoveLast
                        strFileNameNew = CurrentProject.Path & "\Files\" & .Fields(2)
                    End With
                FileCopy strFileName, strFileNameNew
                    If Err Then
                        'Debug.Print Err.Number; Err.Description
                        Err.Clear
                        rst.Delete
                        MsgBox "Ooopps!..." & vbNewLine & "Не смогли прикрепить файл!", vbCritical
                    Else
                            With Me.lstFileName
                                .Requery
                                .Value = rst.Fields(0)
                            End With
                        lstFileName_Click
                    End If
                rst.Close
            Else
                MsgBox "А что отказались?", vbInformation
            End If
    End With
Set rst = Nothing
Set dlgOpenFile = Nothing
End Sub


Сообщение было отредактировано: 4 фев 20, 23:52
4 фев 20, 23:52    [22073215]     Ответить | Цитировать Сообщить модератору
 Re: база данных со ссылками на файлы  [new]
Панург
Member

Откуда: настоящему индейцу завсегда везде ништяк
Сообщений: 4620
RusGor
Set rst = CurrentDb.OpenRecordset("tblattachedfiles", dbOpenDynaset)
Тут скорее всего нужен запрос с явной сортировкой по ключу, иначе ничто не гарантирует что новая запись будет последней в коде ниже. Да и вообще нужно подумать над этим набором - зачем тащить всю таблицу?...
RusGor
                        .Requery
                        .MoveLast



RusGor
.Bookmark = .LastModified
Это лишнее в данном случае, ИМХО.


RusGor
                FileCopy strFileName, strFileNameNew
                    If Err Then
                        Err.Clear
                        rst.Delete
                        MsgBox "Ooopps!..." & vbNewLine & "Не смогли прикрепить файл!", vbCritical
Эту часть для данного случая я бы протестировал дополнительно. Тормознул бы код выше на точке останова и открыл бы файл на редактирования другой программой.

Сообщение было отредактировано: 5 фев 20, 04:09
5 фев 20, 04:06    [22073308]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: Ctrl  назад   1 2 3 [4]      все
Все форумы / Microsoft Access Ответить