Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Почему замена Jet.OLEDB на ACE.OLEDB не работает?
 
#1
05.01.2017 21:09:26
Итак, вначале было слово:
Код
Dim rstDAO As Object
Dim strSQL01 As String,  strSQL As String
Dim sCon$
Dim cn As Object    '  As ADODB.Connection
Dim rs1 As Object   '  As ADODB.Recordset
Dim rs31 As Object   '  As ADODB.Recordset
Set cn = CreateObject("ADODB.Connection") ' as New ADODB.Connection
'Dim cn As New ADODB.Connection
Set rstDAO = CreateObject("ADODB.Recordset") ' as New ADODB.Recordset
Set rs1 = CreateObject("ADODB.Recordset")
Set rs31 = CreateObject("ADODB.Recordset")

 With Application
        .ScreenUpdating = False
End With

sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName _
& ";Extended Properties=""Excel 8.0;IMEX=1;HDR=No"";"

cn.Open sCon

If Not cn.State = 1 Then Exit Function

'save current sheet name
strSQL = "[" & ActiveSheet.Name & "$]"
strSQL01 = "Select DISTINCT F1 from " & strSQL & ""
rstDAO.Open strSQL01, cn

Как оказалось, это все хорошо и работает, но только если у вас не 64-битный офис
В 64 битном офисе же провайдер Jet.OLEDB следует заменить на ACE.OLEDB.12.0, и казалось бы все, многим этого достаточно. Мне как всегда повезло быть срежи немногих.
  1. Вариант 1 - ACE.OLEDB.12.0
    Заменяем sCon:
    Код
    sCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName _
& ";Extended Properties=""Excel 12.0;HDR=No"";"

    В таком раскладе перестает работать strSQL01 = "Select DISTINCT F1 from " & strSQL & "". Если добавлять скобки или извращаться - пишет "слишком много параметров, ожидаю  лишь 1"
  2. Вариант 2 - MSDASQL
    Заменяем sCon:
    Код
    sCon = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & ThisWorkbook.FullName & "; HDR=No"";"

    В таком раскладе колличество записей в выборке = 0, хотя на литсте записи явно есть
           
  3. Вариант 3 - Через ДРАЙВЕР
    Заменяем sCon:
    Код
    sCon = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ThisWorkbook.FullName & ";"

    тоже нет записей
Короче, кто то с таким сталкивался, что я не так делаю? (при том чт о в 32 бит и через ДЖЕТ всё ж работает как часики
Мы в Екселе не работаем, мы в нём живём!
 
 
 
#2
05.01.2017 22:01:07
Приложите книгу - проверю в 64-битном офисе.
There is no knowledge that is not power
 
 
 
#3
06.01.2017 19:27:07
не знаю, чем вам поможет но у меня уже мозг закипел.
Задача выбрать из колонки 1 все уникальные значения, затем по каждому значению создать лист и кинуть на него выборку данных по коллонке 1.
Мы в Екселе не работаем, мы в нём живём!
 
 
 
#4
06.01.2017 19:42:49
1. В коде у Вас написано:
Код
sCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName _
& ";Extended Properties=""Excel 8.0;HDR=No"";"
В сообщении #1 у Вас указано Excel 12.0. Нестыковка, однако.

2. Почему rstDAO, когда используется библиотека ADO? :)
3. Чтобы код работал, добавьте одну строку (среднюю):
Код
strSQL01 = "Select Distinct F1 from " & strSQL & ";"
rstDAO.CursorLocation = 3 ' <= Добавьте эту строку (adUseClient)
rstDAO.Open strSQL01, cn
Изменено: SuperCat - 06.01.2017 20:07:59
There is no knowledge that is not power
 
 
 
#5
06.01.2017 19:46:24
Цитата
SuperCat написал:
2. Почему rstDAO, когда используется библиотека ADO?
Сначала было дао, переминовывать не стал :)
Мы в Екселе не работаем, мы в нём живём!
 
 
 
#6
06.01.2017 19:50:45
Доброе время суток
Что-то по вашему коду, как и по комментарию в теме, сложно понять чего вы всё же добиваетесь. Как понял. Раскидать данные с листа Sheet1 данные по новым листам в книге так чтобы на каждом из листов были данные, относящиеся только к одному уникальному значению столбца А листа Sheet1. Плюс, добавил переименование создаваемого листа в имя этого значения. Код отработал в Excel 2016, 64bit, Windows 7.
Код
Public Sub GetUniqueODBC()
    Const baseStrConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=$1;Extended Properties='Excel 12.0;HDR=NO';"
    Dim pConn As New ADODB.Connection
    Dim sheetNames As New ADODB.Recordset
    Dim allTable As New ADODB.Recordset
    Dim nextSheet As Worksheet, sheetName As String
    
    pConn.Open Replace$(baseStrConn, "$1", ThisWorkbook.FullName)
    sheetNames.CursorLocation = adUseClient
    sheetNames.Open "Select Distinct F1 From [Sheet1$] Order By F1", pConn
    allTable.Open "Select * From [Sheet1$]", pConn
    Do Until sheetNames.EOF
        Set nextSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count), Type:=xlWorksheet)
        sheetName = CStr(sheetNames(0).Value)
        nextSheet.Name = sheetName
        allTable.Filter = "F1 = " & sheetName
        allTable.MoveFirst
        nextSheet.Range("A1").CopyFromRecordset allTable
        sheetNames.MoveNext
    Loop
    sheetNames.Close: Set sheetNames = Nothing
    allTable.Close: Set allTable = Nothing
    pConn.Close: Set pConn = Nothing
End Sub

P. S. Естественно, проверки, что лист с таким именем уникального значения существует нет. Если есть, то будет ошибка.

С наступающим Рождеством!
Изменено: Андрей VG - 06.01.2017 19:51:55
 
 
 
#7
06.01.2017 22:24:15
Цитата
panix1111 написал:
Задача выбрать из колонки 1 все уникальные значения, затем по каждому значению создать лист и кинуть на него выборку данных по коллонке 1
Это можно и без тяжелой артиллерии сделать - использовать Collection, а не Connection :)
Код
Sub Pa()
Dim x, v(), cl As New Collection
  Application.ScreenUpdating = False
  With Worksheets(1)
    v = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Value
    .Rows(1).Insert
    On Error Resume Next
    For Each x In v
      cl.Add 0, CStr(x)
      If Err Then
        Err.Clear
      Else
        .Cells.AutoFilter 1, x
        Worksheets.Add After:=Sheets(Sheets.Count)
        .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Copy Cells(1, 1)
        ActiveSheet.Name = x
      End If
    Next
    .Rows(1).Delete
  End With
  Application.ScreenUpdating = True
End Sub
Изменено: Казанский - 06.01.2017 22:26:28
 
 
 
Страницы: 1
Читают тему
Наверх