Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
запись данных в БД Access
 
Код
Option Explicit
Sub DataFromAccess()
Dim CON As Object
Dim RS As Object
Dim strSQL As String
Dim i%

Set CON = CreateObject("ADODB.Connection")
CON.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\Источник БД Access.accdb"
CON.Open

Set RS = CreateObject("ADODB.Recordset")
RS.Open strSQL, CON



 
 ' Добавляем новую запись в базу
 
    Private Sub btnClose_Click()
    Set RS = New ADODB.Recordset
    RS.Open "OPROS1"
    RS.AddNew
    RS!txtFamiliya = txtFamiliya.Text
    RS!txtImya = txtImya.Text
    RS!txtOtchestvo = txtOtchestvo.Text
    RS.Update
    RS.Close
    Set RS = Nothing
    

End Sub

Подключение идет, а  вот записи нет. Можете помочь с ошибкой?
 
vsolovev, не вникал, но недавно видел такую статью — может поможет  ;)
«Тот, кто несет фонарь, спотыкается чаще, чем тот, кто идет следом.»
Иоганн Пауль Фридрих Рихтер
 
немного не то, у меня там форма VB (txtFamiliya, txtImya, Otchest),  а в Access создана таблица OPROS1....куда и хотелось писать данные с формы опроса.
 
Доброе время суток
Как-то так попробуйте
Код
RS.Open "Select * From OPROS1 Where txtFamiliya Is Null", CON, adOpenStatic, adLockOptimistic
 
Андрей VG,что то не получается. Может с файлом будет нагляднее?
Изменено: vsolovev - 11 Сен 2018 15:02:07
 
Цитата
vsolovev написал:
Может с файлом будет нагляднее?
А у вас в файле всё тоже самое - на что глядеть?
У меня вот так записалось без проблем.
Код
Public Sub testInsert()
    Dim CONN As New ADODB.Connection
    Dim RS As New ADODB.Recordset
    CONN.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Path\Источник БД Access.accdb;Mode=Share Deny None;"
    CONN.Open '
    RS.Open "Select * From OPROS1 Where Код Is Null", CONN, adOpenStatic, adLockOptimistic
    RS.AddNew
    RS("txtFamiliya").Value = "Кузнецов"
    RS("txtImya").Value = "Никита"
    RS("txtOtchestvo").Value = "Фёдорович"
    RS.Update
    RS.Close: Set RS = Nothing
    CONN.Close: Set CONN = Nothing
End Sub
 
как пример
подключена библиотека Microsoft ActiveX Data Objects 2.1 Library

Код
 Dim cN As New ADODB.Connection
 Dim cmd As New ADODB.command
 Dim rs As New ADODB.Recordset
 
 cN.Provider = "Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=123" 
 cN.ConnectionString = "d:\1.mdb"
 cN.Open

 With cmd
     .ActiveConnection = cN
     .CommandText = "INSERT INTO Таблиця (Поле1,Поле2) VALUES ('Текст1','ТЕкс2')"
     .Execute
 End With
 
Вот таким монстром вставлял, тут часть кода имена таблиц вытаскивает из БД, оставил на всяк случай авось пригодится  :D
Для работы кода нужно подключить библиотеки (см. рисунок)

Код
Sub iAccessConnection()
'    -----------------------------
    Dim iConnection As ADODB.Connection
    Dim iRecordset As ADODB.Recordset
    Dim objADOX As ADOX.Catalog, objTable As Object
    Dim iPath$, iSelect$, cnct$, i%, FieldName$, iValue$
'    -----------------------------

    Set iConnection = New ADODB.Connection
    Set iRecordset = New ADODB.Recordset
    Set objADOX = New ADOX.Catalog
    iPath = ThisWorkbook.Path & Application.PathSeparator
    cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & iPath & "Источник БД Access.accdb"
    iConnection.ConnectionString = cnct
    iConnection.Open
'    objADOX.ActiveConnection = iConnection.ConnectionString
'    For Each objTable In objADOX.Tables
'        i = i + 1
'        Cells(i, 1) = objTable.Name
'    Next objTable
    iSelect = "Select * From OPROS1"
    With frmTest
        iValue = Join(Array(.txtFamiliya.Value, .txtImya.Value, .txtOtchestvo.Value, _
            .CombPodrazd.Value, .chbVO.Value), "','")
        iValue = "'" & iValue & "'"
    End With
    With iRecordset
        .Open iSelect, iConnection
        For i = 2 To .Fields.Count
            Cells(1, i) = .Fields(i - 1).Name
            FieldName = FieldName & .Fields(i - 1).Name & ","
        Next i
        FieldName = Left(FieldName, Len(FieldName) - 1)
        iSelect = "Insert Into OPROS1 (" & FieldName & ") Values (" & iValue & ")"
        Range("a2").CopyFromRecordset iRecordset
        .Close
        .Open iSelect, iConnection
    End With
End Sub
Снимок.PNG (33.19 КБ)
Изменено: Nordheim - 11 Сен 2018 21:55:00
"Все гениальное просто, а все простое гениально!!!"
 
Коллеги, а если Фамилия будет Д'Артаньян? ;)
 
Цитата
Андрей VG написал:
Коллеги, а если Фамилия будет Д'Артаньян?
В таком случае все пропало  8-0 , придется брать псевдоним ну например Дартаньян  :D
"Все гениальное просто, а все простое гениально!!!"
 
Андрей VG, Вы не могли бы скинуть исходники(базу и ексель), если можно? Голову сломал, не работает....возможно у меня что то с настройками (хочу сравнить).
 
vsolovev,вы все предложенные варианты пробовали?
 
ivanok_v2,да))) и у меня постоянно выдает ошибку(((( хотелось увидеть исходник, понять свою ошибку!
 
подключите библиотеку(Tools-References), которую я вам написал выше.
попробуйте мой код.
Inser должен сработать.
если нет скиньте принт скрин ошыбки и кода на котором она выскакивает.
Изменено: ivanok_v2 - 11 Сен 2018 17:38:34
 
ivanok_v2,  
 
vsolovev, у вас расширение Аксес БД mdb или accdb?
 
Цитата
ivanok_v2 написал:
accdb
accdb, но руками меняю на mdb
 
vsolovev,Нет, разширение поменяйте в коде. Файла нельзя
или переведите БД у формат mdb через аксес
 
Цитата
ivanok_v2 написал:
Нет, разширение поменяйте в коде
сменил, выдает аналогичную ошибку. Скиньте плиз Ваши исходники, может они тоже у меня не сработают))) не смешно кнечно.
 
чуть позже(через час). сейчес нет возможности.
 
ivanok_v2, спасибо  
 
Цитата
vsolovev написал:
сменил, выдает аналогичную ошибку
пересохраните accdb в mdb и проблем не будет хоть с 4, хоть с 12. Либо используйте
Код
Provider=Microsoft.ACE.OLEDB.12.0
 
vsolovev, А можно еще раз БД подгрузить?
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Nordheim написал:
А можно еще раз БД подгрузить?
 
Структура БД другая, т.е. отсутствует таблица OPROS1, но присутствует пустая sd
"Все гениальное просто, а все простое гениально!!!"
 
всем спасибо, добился нужного эффекта.
 
Цитата
Андрей VG написал:
Коллеги, а если Фамилия будет Д'Артаньян?
тогда он будет Д`Артаньян
 
Цитата
ivanok_v2 написал:
тогда он будет Д`Артаньян
Всё же лучше не вводить лишних сущностей :)
Код
Replace$("Д'Артаньян", "'", "''")
Страницы: 1
Читают тему (гостей: 1)
Наверх