Option Compare Database

Sub ИмпортИзOLAP()

Dim Cn As Object
Dim РекордсетИмпорт As Object
Dim РекордсетТаблицаAccess As Object

Set Cn = CreateObject("ADODB.Connection")
Cn.ConnectionString = "Provider=MSOLAP.3;" & _
    "Integrated Security=SSPI;" & _
    "Persist Security Info=True;" & _
    "Initial Catalog=profit;" & _
    "Data Source=.......................;" & _
    "MDX Compatibility=1;" & _
    "Safety Options=2;" & _
    "MDX Missing Member Mode=Error"
Cn.Open

Set РекордсетИмпорт = CreateObject("ADODB.Recordset")
Set РекордсетИмпорт.activeconnection = Cn
РекордсетИмпорт.Source = "Select {} on 0, [Города].[Город].[Город] on 1 from profit"

РекордсетИмпорт.Open

Set РекордсетТаблицаAccess = CreateObject("ADODB.Recordset")
РекордсетТаблицаAccess.Open "Города", CurrentProject.Connection

If Not (РекордсетИмпорт.BOF = True And РекордсетИмпорт.EOF = True) Then
    РекордсетИмпорт.MoveFirst
    
    Do While Not РекордсетИмпорт.EOF
        РекордсетТаблицаAccess.AddNew
        РекордсетТаблицаAccess.Fields(0) = РекордсетИмпорт.Fields(0)
        РекордсетИмпорт.MoveNext
    Loop
End If

'Set РекордсетИмпорт = Nothing
'Set РекордсетТаблицаAccess = Nothing
РекордсетИмпорт.Close
РекордсетТаблицаAccess.Close
Cn.Close

End Sub

    Do While Not РекордсетИмпорт.EOF
        РекордсетТаблицаAccess.AddNew
        РекордсетТаблицаAccess.Fields(0) = РекордсетИмпорт.Fields(0)
        РекордсетТаблицаAccess.Update
        РекордсетИмпорт.MoveNext
    Loop

    Do While Not РекордсетИмпорт.EOF
        РекордсетТаблицаAccess.AddNew
        РекордсетТаблицаAccess.Fields(0) = РекордсетИмпорт.Fields(0)       
        РекордсетИмпорт.MoveNext
    Loop
 РекордсетТаблицаAccess.UpdateBatch

РекордсетТаблицаAccess.Open "Города", CurrentProject.Connection

РекордсетИмпорт.Source = "Select {} on 0, [Города].[Город].[Город] on 1 from profit"

РекордсетТаблицаAccess.LockType = 2

РекордсетТаблицаAccess.LockType =adLockPessimistic

    Do While Not РекордсетИмпорт.EOF
        РекордсетТаблицаAccess.AddNew
        РекордсетТаблицаAccess.Fields(0) = РекордсетИмпорт.Fields(0)
        РекордсетТаблицаAccess.Update
        РекордсетИмпорт.MoveNext
    Loop

    Do While Not РекордсетИмпорт.EOF
        РекордсетТаблицаAccess.AddNew
        РекордсетТаблицаAccess.Fields(0) = РекордсетИмпорт.Fields(0)       
        РекордсетИмпорт.MoveNext
    Loop
 РекордсетТаблицаAccess.UpdateBatch

Sub Test()
Dim РекордсетТаблицаAccess As Object
Set РекордсетТаблицаAccess = CreateObject("ADODB.Recordset")
РекордсетТаблицаAccess.LockType = 2
РекордсетТаблицаAccess.Open "Города", CurrentProject.Connection

For i = 1 To 5
РекордсетТаблицаAccess.AddNew
РекордсетТаблицаAccess.Fields("Города") = "Город " & i
'РекордсетТаблицаAccess.Update
Next i

РекордсетТаблицаAccess.Close
Set РекордсетТаблицаAccess = Nothing
End Sub

Dim РекордсетТаблицаAccess As Object
Set РекордсетТаблицаAccess = CreateObject("ADODB.Recordset")
РекордсетТаблицаAccess.LockType = 2
РекордсетТаблицаAccess.Open "Города", CurrentProject.Connection.Execute("Delete * from [Города]")

Sub ИмпортИзOLAP()

Dim Cn As Object
Dim РекордсетИмпорт As Object
Dim cmd As Object

Dim СтрокаПодключения As String, ТекстЗапроса As String

СтрокаПодключения = "Provider=MSOLAP.3;" & _
    "Integrated Security=SSPI;" & _
    "Persist Security Info=True;" & _
    "Initial Catalog=profit;" & _
    "Data Source=...................;" & _
    "MDX Compatibility=1;" & _
    "Safety Options=2;" & _
    "MDX Missing Member Mode=Error"
    
ТекстЗапроса = "SELECT [Measures].[Отгрузки шт] on 0, [Города].[Город].[Город] on 1 from profit"

Set Cn = CreateObject("ADODB.Connection")
Cn.ConnectionString = СтрокаПодключения
Cn.Open

Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = Cn
cmd.CommandType = 4 'adCmdStoredProc
cmd.CommandText = ТекстЗапроса
Set РекордсетИмпорт = CreateObject("ADODB.Recordset")
РекордсетИмпорт = cmd.Execute()

Set cmd = Nothing
РекордсетИмпорт.Close
Set РекордсетИмпорт = Nothing
Cn.Close
Set Cn = Nothing
End Sub

...
Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = Cn
cmd.CommandType = 4 'adCmdStoredProc
'cmd.CommandText = ТекстЗапроса
Set РекордсетИмпорт = CreateObject("ADODB.Recordset")
РекордсетИмпорт = cmd.Execute(ТекстЗапроса)
...

Set РекордсетИмпорт = CreateObject("ADODB.Recordset")
РекордсетИмпорт = cmd.Execute(ТекстЗапроса)

РекордсетИмпорт.Open cmd

...
ТекстЗапроса = "SELECT [Measures].[Отгрузки шт] on 0, [Города].[Город].[Город] on 1 from profit WHERE @ПараметрДата"

SelectDateMDX = "[Время].[Месяц].&[2016-07-01T00:00:00]"

Set Cn = CreateObject("ADODB.Connection")
Cn.ConnectionString = СтрокаПодключения
Cn.Open

Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = Cn
cmd.CommandType = 1
cmd.CommandText = ТекстЗапроса
cmd.Parameters.Append cmd.CreateParameter("ПараметрДата", 129, 1, 1000, SelectDateMDX) ' ,adChar, adParamInput
Set РекордсетИмпорт = CreateObject("ADODB.Recordset")

РекордсетИмпорт.Open cmd
...

cmd.Parameters.Append cmd.CreateParameter("@ПараметрДата", 129, 1, 1000, SelectDateMDX) 

SELECT [Measures].[Отгрузки шт] on 0, [Города].[Город].[Город] on 1 from profit WHERE [Время].[Месяц].&[2016-07-01T00:00:00]