hi2all
а можно ли из скрипта как- от создавать файлик базы mdb
и в него писались данные...
если есть - киньте в меня ссылкой на примерчик
заранее списибо
Const dbProvider As String = "Microsoft.Jet.OLEDB.4.0"
Function CreateDB(FileName)
Dim cat
Set cat = CreateObject("ADOX.Catalog")
On Error Resume Next
cat.Create "Provider=" & dbProvider & ";Data Source=" & FileName
If Err.Number <> 0 Then
MsgBox Err.Description
End If
On Error GoTo 0
End Function
Const dbProvider As String = "Microsoft.Jet.OLEDB.4.0"
Dim databaseFile
Dim databaseOutput
Dim query
databaseFile = "heap.mdb"
databaseOutput = "result.mdb"
Dim cat, cn
Set cat = CreateDB(databaseOutput)
Set cn = CreateDBConnection(databaseOutput)
'Возможно надо будет раскомментировать
'Set cat = CreateObject("ADOX.Catalog")
'Set cat.ActiveConnection = cn
LinkTable cat, "SourceData", databaseFile, "Order"
query = "SELECT [Phone], [RecordedDataTime] INTO [result] FROM [SourceData] WHERE [ServiceNote]=23"
ExecSQL cn, query
UnlinkTable cat, "SourceData"
cn.Close
Function CreateDB(FileName)
Dim cat
Set cat = CreateObject("ADOX.Catalog")
cat.Create "Provider=" & dbProvider & ";Data Source=" & FileName
Set CreateDB = cat
End Function
Function CreateDBConnection(Database)
Dim DBConnection
Set DBConnection = CreateObject("ADODB.Connection")
With DBConnection
.Provider = dbProvider
.Properties("User ID") = "Admin"
.Properties("Data Source") = Database
.Open
End With
Set CreateDBConnection = DBConnection
End Function
Private Sub LinkTable(Catalog, Table, File, RemoteTable)
Dim Table
Set Table = CreateObject("ADOX.Table")
With Table
.Name = Table
Set .ParentCatalog = Catalog
.Properties("Jet OLEDB:Link Provider String") = dbProvider
.Properties("Jet OLEDB:Link Datasource") = File
.Properties("Jet OLEDB:Remote Table Name") = RemoteTable
.Properties("Jet OLEDB:Create Link") = True
End With
Catalog.Tables.Append Table
End Sub
Sub UnlinkTable(Catalog, Table)
Dim I
For I = Catalog.Tables.Count-1 To 0 Step -1
If Catalog.Tables(I).Name = Table Then
If Catalog.Tables(I).Type = "LINK" Then
Catalog.Tables.Delete I
End If
End If
Next
End Sub
Sub ExecSQL(DBConnection, SQL)
Dim cmd
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = DBConnection
cmd.CommandType = 1 'Text
cmd.CommandText = SQL
cmd.Execute , , 128
End Sub
Function GetRecordset(DBConnection, SQL)
Dim rs
Set rs = CreateObject("ADODB.Recordset")
Set rs.ActiveConnection = DBConnection
rs.CursorLocation = 3 'adUseClient
rs.CursorType = 3 'adOpenStatic
rs.LockType = 1 'adLockReadOnly
rs.Source = SQL
rs.Open
Set GetRecordset = rs
End Function
Function IfNull(Value, NullValue)
If IsNull(Value) Then
IfNull = NullValue
Else
IfNull = Value
End If
End Function
Function NullIf(Value, NullValue)
If Value = NullValue Then
NullIf = Null
Else
NullIf = Value
End If
End Function
Function QuoteString(Value)
QuoteString = "'" & Replace(Value, "'", "''") & "'"
End Function
SELECT [Phone], [RecordedDataTime]
INTO [result] IN 'result_database.mdb'
FROM [SourceData]
WHERE [ServiceNote]=23
Сейчас этот форум просматривают: AhrefsBot, Yandex-бот и гости: 33