Alexus12если вместо ODBC - ничего не заработает
поелику Excel одбцшным драйвером в Access ходит
что и видишь ты макрос записав
подправь SELECT на нужный тебе - и счастлив будешь
веришь нет, но нашел в хэлпе вариант с рекордсетом, только рекорсет ADODB, а мне нужно DAO. И так его пробовал и сяк, а нифига не получается. Может поможете?
Хэлп:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
Dim cnnConn As ADODB.Connection
Dim rstRecordset As ADODB.Recordset
Dim cmdCommand As ADODB.Command
' Open the connection.
Set cnnConn = New ADODB.Connection
With cnnConn
.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0"
.Open "C:\perfdate\record.mdb"
End With
' Set the command text.
Set cmdCommand = New ADODB.Command
Set cmdCommand.ActiveConnection = cnnConn
With cmdCommand
.CommandText = "Select Speed, Pressure, Time From DynoRun"
.CommandType = adCmdText
.Execute
End With
' Open the recordset.
Set rstRecordset = New ADODB.Recordset
Set rstRecordset.ActiveConnection = cnnConn
rstRecordset.Open cmdCommand
' Create a PivotTable cache and report.
Set objPivotCache = ActiveWorkbook.PivotCaches.Add( _
SourceType:=xlExternal)
Set objPivotCache.Recordset = rstRecordset
With objPivotCache
.CreatePivotTable TableDestination:=Range("A3"), _
TableName:="Performance"
End With
With ActiveSheet.PivotTables("Performance")
.SmallGrid = False
With .PivotFields("Pressure")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Speed")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Time")
.Orientation = xlDataField
.Position = 1
End With
End With
' Close the connections and clean up.
cnnConn.Close
Set cmdCommand = Nothing
Set rstRecordSet = Nothing
Set cnnConn = Nothing
Мой рекордсет:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
Sub Макрос3()
Dim dbAccess As Database
Dim TestTable As DAO.Recordset
Dim Sql_String As String
Dim a, b As Date
Dim c As Integer
On Error GoTo ErrorsDB
Set dbAccess = OpenDatabase("\\ws228\A_Milk\База\0030.mdb")
Sql_String = "SELECT [003].Дата, [2_Группы].Группа, [3_ Марки].Марка, [2_Ассортимент1].Товар, Sum([003].Продано_кг) AS Заявка" & _
" FROM [3_ Марки] INNER JOIN (2_Группы INNER JOIN (2_Виды INNER JOIN ((2_Ассортимент INNER JOIN 2_Ассортимент1 ON [2_Ассортимент].Ключ = [2_Ассортимент1].Ключ) INNER JOIN 003 ON [2_Ассортимент1].Ключ = [003].Ассортимент) ON [2_Виды].Ключ = [2_Ассортимент].Вид) ON [2_Группы].Ключ = [2_Виды].Группа) ON [3_ Марки].Ключ = [2_Ассортимент].Марка" & _
" GROUP BY [003].Дата, [2_Группы].Группа, [3_ Марки].Марка, [2_Ассортимент1].Товар;"
Set TestTable = dbAccess.OpenRecordset(Sql_String)
If (TestTable.RecordCount > 0 ) Then
Cells( 2 , 1 ).CopyFromRecordset TestTable
intFildCount = TestTable.Fields.Count - 1
For intI = 0 To intFildCount
Cells( 1 , intI + 1 ).Value = TestTable.Fields(intI).Name
Next intI
Else: MsgBox "Not Found"
End If
TestTable.Close
GoTo Ends
ErrorsDB:
MsgBox "Произошла ошибка"
Ends:
End Sub
