| |
|
|
| | У кого нибудь имеется???
Функция переноса наименований столбцов табицы в описание столбцов таблицы.
Вручную запарился - мозоль на кнопке мышки.....  | |
| |
| |
| |
|
|
| | как-то так для всех таблиц и всех полей
ну еще бы надо вычленить системные и связанные таблицы
Public Sub setFieldDescription()
Dim tbl As TableDef
Dim db As dao.Database
Dim fld As dao.Field
Dim prpNew As dao.Property
On Error GoTo Err_Property
Set db = CurrentDb
For Each tbl In db.TableDefs
For Each fld In tbl.Fields
fld.Properties("Description") = fld.name
Next
Next
Err_Property:
' Ошибка 3270 означает, что свойство не найдено.
If DBEngine.Errors(0).Number = 3270 Then
' Создает свойство, задает его значение и добавляет
' свойство в семейство Properties.
Set prpNew = fld.CreateProperty("Description", dbText, fld.name)
fld.Properties.Append prpNew
Resume Next
Else
' При возникновении другой ошибки выводит сообщение.
MsgBox "Код ошибки: " & Err.Number & vbCr & Err.Description
End If
End Sub
|
А ты что поля по русски называешь?  | |
| |
| |
| |
|
|
| | Поля, по аглицки а вот коментарий к полям.....
Чёта я в терминологии запутался.
Наименование поля -ID
Наименование колонки - идентификатор
Описание ....................................идентификатор ..............
|
| |
| |
| |
| |
|
|
| | какие колонки!!!?
Есть поле
у него есть свойства:
name - имя
Caption - подпись
Description - описание
и т.д.
Description - это то что в режиме конструктора показывается вверху справа от имени после типа поля
а
Caption - это то что внизу где свойства поля
тебе что куда нужно перенести? | |
| |
| |
| |
|
|
| |  Виноват 
Хотел сказать
присвоить (Description) = значение (Caption)
| |
| |
| |
| |
|
|
| | Тогда видимо вот так будет.........
For Each fld In tbl.Fields
fld.Properties("Description") = fld.Properties("Caption")
Next
|
| |
| |
| |
| |
|
|
| | ОГРОМНОЕ СПАСИБО!!!!
ВСЁ ПОПЁРЛО,,,
Public Sub setFieldDescription()
' пренос наименований в описания
Dim tbl As TableDef
Dim db As DAO.Database
Dim fld As DAO.Field
Dim f As Long
Dim prpNew As DAO.Property
On Error GoTo Err_Property
Set db = CurrentDb
For Each tbl In db.TableDefs
If Left(tbl.Name, 4) = "MSys" Then GoTo dalee
If Left(tbl.Name, 4) = "~TMP" Then GoTo dalee
For Each fld In tbl.Fields
fld.Properties("Description") = fld.Properties("Caption")
Next
dalee:
Next
Err_Property:
' Ошибка 3270 означает, что свойство не найдено.
If DBEngine.Errors(0).Number = 3270 Then
' Создает свойство, задает его значение и добавляет
' свойство в семейство Properties.
Set prpNew = fld.CreateProperty("Description", dbText, fld.Properties("Caption"))
fld.Properties.Append prpNew
Resume Next
Else
' При возникновении другой ошибки выводит сообщение.
MsgBox "Код ошибки: " & Err.Number & vbCr & Err.Description
End If
End Sub
Private Sub Кнопка0_Click()
setFieldDescription
End Sub
|
| |
| |
| |
| |
|
|
| | ну вот.
А то "столбцы", "колонки" | |
| |
| |
| |
|
|
| | Вопрос. Чем плохо называть поля таблиц и сами таблицы кирилицей?
Как-то влияет на надежность базы в сети? Способствует разрушению базы? Дурной тон в среде программистов?
Просто интересно. | |
| |
| |
| |
|
|
| | возможно сейчас это уже где-то дань традиции.
в прошлых версиях MSA встречались проблемы с русскими именами полей, причем очень трудно диагностируемые.
При переносе таблиц на MS SQL сервер таблицы и поля названные по русски вызывали ошибку при переносе, и на сервере не работали.
Так просто удобнее набирать код - не нужно переключать раскладку, а то операторы по английски, а имена переменных и полей по русски.
Помогает выучить англицские слова :-) | |
| |
| |
| |
|
|
| | У меня давеча, при ответе на вопрос, отказывался работать запрос на объединение:
то ему вдоль что-то не нравится, то поперек нехорошо.
Переименовал таблицу - все моментом заработало.
В оригинальном имени были и латиница и кириллица и цифры и символы подчеркивания, винегред какой-то.  | |
| |
| |
| |
|
|
| | Спасибо просветили. Где-то так и предполагал.  | |
| |
| |
| |
|
|
| | Пробую то же самое в VB6
Не получается 
Public Function FUN_FIELD_TABLE(STR_PATH_BAZA As String, STR_BAZA_NAME As String, STR_TABLE_NAME As String)
' перебор полей таблицы
Dim rst As ADODB.Recordset ' набор записей
Dim Field As ADODB.Field
Set rst = New ADODB.Recordset
rst.Open "select * FROM KEYBOARD_TBL", GLB_con, adOpenKeyset, adLockOptimistic
For Each Field In rst.Fields
MsgBox Field.Properties("Caption") - не катит
MsgBox Field.Properties("Type")
'MsgBox Field.Properties("Value") - не катит
Call FUN_СREATE_FIELD(STR_PATH_BAZA, STR_BAZA_NAME, STR_TABLE_NAME, Field.Name, "Value")
'
Next
Set rst = Nothing
End Function
|
| |
| |
| |
| |
|
|
| | Ты пытаешься изменять свойства полей recordset, кроме того ты используешь ADO
В примере используется DAO и объекты Field объета Tabledef
или используй DAO
или используй ADOX | |
| |
| |
|
|
|
|
| |
|
|
| | Чёта ваще ничё не хочет пахать
Public Function FUN_FIELD_TABLE(STR_PATH_BAZA As String, STR_BAZA_NAME As String, STR_TABLE_NAME As String)
'Dim adoxCat As New ADOX.Catalog
Dim adoxCat As ADOX.Catalog
Dim adoxTbl As ADOX.Table
Dim Field As ADOX.Column
Dim strDBPath As String
Set adoxCat = New ADOX.Catalog
strDBPath = FUN_Patch_File(STR_PATH_BAZA, STR_BAZA_NAME) '“C: ExamplDBMyDB.mdb”
adoxCat.ActiveConnection = "provider=Microsoft.JET.OLEDB.4.0;" & _
"data source=" & strDBPath
For Each adoxTbl In adoxCat.Tables
If adoxTbl.Name = STR_TABLE_NAME Then
For Each Field In adoxTbl.Columns
MsgBox Field.Name
MsgBox Field.Properties("Type")
MsgBox Field.Properties("Value")
Next
End If
Next
'Set rst = Nothing
End Function
|
| |
| |
| |
| |
|
|
| | И так тожа не пахает
Dim adoxCat As ADOX.Catalog
Dim col As ADOX.Column
Dim strDBPath As String
Set adoxCat = New ADOX.Catalog
strDBPath = FUN_Patch_File(STR_PATH_BAZA, STR_BAZA_NAME) '“C: ExamplDBMyDB.mdb”
adoxCat.ActiveConnection = "provider=Microsoft.JET.OLEDB.4.0;" & _
"data source=" & strDBPath
For Each col In adoxCat(STR_BAZA_NAME).Columns
MsgBox col.Name
Next col
|
| |
| |
| |
| |
|
|
| | Опять нет таких свойств
Dim adoxCat As ADOX.Catalog
Dim col As ADOX.Column
Dim adoxTbl As ADOX.Table
Dim strDBPath As String
Set adoxCat = New ADOX.Catalog
adoxCat.ActiveConnection = GLB_con
For Each adoxTbl In adoxCat.Tables
If adoxTbl.Name = "USER_ACCESS" Then
For Each col In adoxCat(adoxTbl.Name).Columns
MsgBox col.Name
MsgBox col.Properties("Type")
MsgBox col.Properties("Description")
Next col
End If
Next adoxTbl
|
| |
| |
| |
| |
|
|
| | КАК выловить Description???????? | |
| |
| |
| |
|
|
| | Зачем? 
Медленно это. | |
| |
| |
| |
|
|
| | А как быстро??? | |
| |
| |
| |
|
|
| | Запиши в сервисную табличку все что надо, и оттуда почитывай. Раза в 3-4 быстрее на родных таблицах Access, чем читать доп. свойства полей таблиц. | |
| |
| |
| |
|
|
| | Кабы знать заранее что там будет.......... | |
| |
| |
| |
|
|
| |
А что там может быть?
И кто кроме автора туда что писать может/будет?
Что-то Сергей Александрович вы недоговариваете. | |
| |
| |
|
|
| |
|
|
| | Создал я новую базу программно
Создал там программно таблу
Поля таблы
Всё программно и точно как источник - всё автоматом
Теперь надо перенести данные тожа автоматом из соответствующего поля в аналогичное и всё программно.....
и сижу с бараном на новые ворота любуемся
у него (у барана) рога в раскарячку, а у мну мозг аннннналллогична. | |
| |
| |
| |
|
|
| |
Public Function FUN_TRANSFER_DATA(STR_PATH_BAZA As String, STR_BAZA_NAME As String, STR_TABLE_NAME As String)
' Добавление ДАННЫХ В таблицу выгрузки из арма
Dim Field As ADODB.Field
Dim WHERE_connection As ADODB.Connection ' подключение к базе КУДА
Dim RST_FROM_WHERE As ADODB.Recordset ' ОТКУДА
Dim RST_WHERE As ADODB.Recordset 'КУДА
Dim strDBPath As String ' ПУТЬ
strDBPath = FUN_Patch_File(STR_PATH_BAZA, STR_BAZA_NAME) ' ПУТЬ К НОВОЙ БАЗЕ
WHERE_connection = "provider=Microsoft.JET.OLEDB.4.0;" & _
"data source=" & strDBPath
Set RST_FROM_WHERE = New ADODB.Recordset
Set RST_WHERE = New ADODB.Recordset
RST_FROM_WHERE.Open "SELECT * " & STR_TABLE_NAME, GLB_con, adOpenKeyset, adLockOptimistic
RST_WHERE.Open "SELECT * " & STR_TABLE_NAME, WHERE_connection, adOpenKeyset, adLockOptimistic
If RST_FROM_WHERE.EOF = True Then
RST_FROM_WHERE.Close
Set RST_FROM_WHERE = Nothing
Exit Function
End If
If Not RST_FROM_WHERE.BOF Then RST_FROM_WHERE.MoveFirst
Do While Not RST_FROM_WHERE.EOF
А ТУТА ВОТ МЫ С БАРАНОМ
RST_FROM_WHERE.MoveNext
Loop
End Function
|
| |
| |
| |
| |
|
|
| | То есть:
Ты это делаешь программкой, писаной в VB6.
Файл-оригинал и файл-копия пользуются пользователями в ACCESS-е?
Так что-ль? | |
| |
| |
| |
|
|
| | Да программкой в VB6
Файл-оригинал и файл-копия
|
Оне тожа используются программкой
а вот уже программка - та использует меня... | |
| |
| |
| |
|
|
| | Глянь сюда:
http://www.hiprog.com/forum/read.php?id_forum=3&id_theme=5236&page=1
Там VB-процедура перегоняет данные запросом из XLS в MDB.
Подправь под себя. | |
| |
| |
|
|
|
|
|
|
| |
|
|
| |
Public Sub PrintDescriptionWithADOX()
Dim adoxCat As ADOX.Catalog
Dim adoxTbl As ADOX.Table
Dim adoxCol As ADOX.Column
Set adoxCat = New ADOX.Catalog
adoxCat.ActiveConnection = CurrentProject.Connection 'Здесь твой коннекшн нужен будет
For Each adoxTbl In adoxCat.Tables
If adoxTbl.Type = "TABLE" Then
With adoxTbl
For Each adoxCol In .Columns
Debug.Print .Name, adoxCol.Name, adoxCol.Properties("Description")
Next adoxCol
End With
End If
Next adoxTbl
Set adoxCat = Nothing
Set adoxTbl = Nothing
End Sub
|
Вырезано отсюда:
http://hiprog.com/index.php?option=com_content&task=view&id=251661555
Как всегда спасибо Олегу. | |
| |
| |
| |
|
|
| | Спасибо, Lukas, Олегу !!! | |
| |
| |
| |
|
|
| | DAO, ADO,ADOX
Никогда не связывался с этой хренью. Пришлось вот блин. | |
| |
| |
| |
|
|
| | Интересно, как разрабатывать СУБД, не используя инструментов доступа к данным?
На самом деле, Access сам использует эти инструменты в тени, предоставляя пользователю(разработчику) графические интерфейсы, избавляя в простейших случаях от изучения этих библиотек. | |
| |
| |
| |
|
|
| | Я тута вот.....
Public Function FUN_СREATE_MDB(STR_PATH_BAZA As String, STR_BAZA_NAME As String)
' Создание пустой базы данных
' Объявляем необходимые переменные
Dim AdoxCat As ADOX.Catalog
Dim StrDBPath As String
''Устанавливаем опции
StrDBPath = FUN_Patch_File(STR_PATH_BAZA, STR_BAZA_NAME) '“C: ExamplDBMyDB.mdb”
Set AdoxCat = New ADOX.Catalog
If FUN_FILE_YES_NO(StrDBPath) = True Then
If FUN_Vopros("Файл " & StrDBPath & vbCrLf & " уже существует..." & vbCrLf & " Заменить его ???", vbQuestion) = False Then
Exit Function
Else
FUN_Delete_File_Name (StrDBPath)
End If
End If
' Создание базы
AdoxCat.Create "provider=Microsoft.JET.OLEDB.4.0;" & _
"data source=" & StrDBPath
Set AdoxCat = Nothing
End Function
Public Function FUN_TRANSFER_TABLE_AND_DATA(STR_PATH_BAZA As String, STR_BAZA_NAME As String, STR_TABLE_NAME As String)
'Создание Таблицы в базе
Dim AdoxCat_TABLE As Object
Dim AdoxTbl_TABLE As Object
Dim StrDBPath As String
StrDBPath = FUN_Patch_File(STR_PATH_BAZA, STR_BAZA_NAME) '“C: ExamplDBMyDB.mdb”
Set AdoxCat_TABLE = CreateObject("ADOX.Catalog")
Set AdoxTbl_TABLE = CreateObject("ADOX.Table")
AdoxCat_TABLE.ActiveConnection = "provider=Microsoft.JET.OLEDB.4.0;" & _
"data source=" & StrDBPath
' Проверка наличия таблицы в базе
For Each AdoxTbl_TABLE In AdoxCat_TABLE.Tables
If AdoxTbl_TABLE.Name = STR_TABLE_NAME Then
MsgBox "Таблица " & STR_TABLE_NAME & " уже имеется в базе " & StrDBPath
End If
Next
GLB_con.Execute "SELECT " & STR_TABLE_NAME & ".* INTO " & STR_TABLE_NAME & " IN '" & StrDBPath & "' From " & STR_TABLE_NAME & " WITH OWNERACCESS OPTION"
Set AdoxCat_TABLE = Nothing
Set AdoxTbl_TABLE = Nothing
Set AdoxCat_TABLE = Nothing
End Function
|
Вроде всё получилося  ,
Как ВЫ считаете??? | |
| |
| |
| |
|
|
| | Красиво получилось. Несколько запятых в конце было бы неплохо. 
А где и для чего это применять можно? Стрункцу пжалста. | |
| |
| |
| |
|
|
| | Это вот када в VB6 работаеш с базой MS Access, на машине самого Access нет.
А надо перенести (скопировать) данные из одной базы в новую, не созданную пока что....
Вот мы её и создаём.....
FUN_СREATE_MDB(STR_PATH_BAZA As String, STR_BAZA_NAME As String)
|
потом
Public Function FUN_TRANSFER_TABLE_AND_DATA(STR_PATH_BAZA As String, STR_BAZA_NAME As String, STR_TABLE_NAME As String)
'Создание Таблицы в базе
|
| |
| |
| |
| |
|
|
| | Ну такую прогу еще найти надо будет. Легче офис полный поставить.
Удачи. | |
| |
| |
| |
|
|
| |
Ну такую прогу еще найти надо будет
|
Простите, я не врубилси.....
Что Вы имеете ввиду - какую прогу ??? | |
| |
| |
| |
|
|
| | Ту которую создаете. Будет ли в свободной продже? Когда ждать? | |
| |
| |
|
|
| |
|
|
| | Бил будет разорен и забухает. | |
| |
| |
| |
|
|
| | А он и так - не просыхает 
Его любая псина знает
Он как напьётся - громко лает
Собак окрестных он пугает
Хотя науке помогает
Его развитья фонд - всяк знает
Там миллиарды он слагает
И бедным щедро помогает
Развитье новшеств поощряет
Друзей пивком он угощает
И нас с тобой - не забывет
Очередную ОС он выпускает
Она и равных то не знает
И линукс вроде отдыхает
Хотя не верю - хрен их знает
Лапшу на уши нам кидает
Цену продукта повышает
и с нас три шкуры он сдирает
За 5 тысчёнок предлагает
На рынке созданный продукт
Поди купи, коли не с рук.............................. | |
| |
| |
|
|
