Запрос ADODB не получает даты

Question

Я столкнулся с каким-то странным поведением Excel и не могу разобраться с этим.

У меня есть лист с большим количеством данных.Для поиска в этом листе я использую набор записей ADODB и SQL-запрос.

Мой запрос довольно прост:

strSQL = "SELECT * FROM [PIRNotes$] WHERE [PIR] = '" & WS & "'"
If rs.state = adStateOpen Then rs.Close
rs.CursorLocation = adUseClient
If cnn.state = adStateOpen Then cnn.Close
cnn.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & _
        ActiveWorkbook.Path & Application.PathSeparator & ActiveWorkbook.Name
cnn.Open

rs.Open strSQL, cnn, adOpenKeyset, adLockOptimistic

Проблема, с которой я сталкиваюсь, заключается в том, что независимо от значения WS иНезависимо от того, сколько записей найдено, каждая запись всегда имеет rs.Fields (2) = Null.

rs.Fields (2) соответствует 3-му столбцу таблицы, который содержит строку, представляющую дату.Все остальные столбцы извлекаются в порядке, данные также содержат строки.

Когда я форматирую ячейки в 3-м столбце как дату и преобразовываю содержимое в реальные даты, тогда запрос выполняется без проблем.

Что может быть причиной такого поведения.У меня нет ни малейшего представления, с чего начать.

Answer 1

Из Excel в Access !!

Следующий скрипт запускается из Access.

Private Sub Command0_Click()

Dim strPathFile As String, strFile As String, strPath As String
Dim blnHasFieldNames As Boolean
Dim intWorksheets As Integer

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
Dim strWorksheets(1 To 3) As String

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file (this code assumes that each worksheet
' with the same name is being imported into a separate table
' for that specific worksheet name)
Dim strTables(1 To 3) As String

' Replace generic worksheet names with the real worksheet names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strWorksheets(1) = "Sheet1"
'strWorksheets(2) = "csco"
'strWorksheets(3) = "sbux"

' Replace generic table names with the real table names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strTables(1) = "TableName1"
strTables(2) = "TableName2"
strTables(3) = "TableName3"

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True

' contains the EXCEL files
strPath = "C:\your_path_here\"

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
For intWorksheets = 1 To 1

      strFile = Dir(strPath & "*.xls")
      Do While Len(strFile) > 0
            strPathFile = strPath & strFile
            DoCmd.TransferSpreadsheet acImport, _
                  acSpreadsheetTypeExcel9, strTables(intWorksheets), _
                  strPathFile, blnHasFieldNames, _
                  strWorksheets(intWorksheets) & "$"
            strFile = Dir()
      Loop

Next intWorksheets

End Sub

Импортирует первый лист из нескольких файлов Excel в папке.Возьмите цикл (For intWorksheets = 1 To 1), если вы просто хотите импортировать данные из одного файла Excel.

Теперь, если вы хотите запустить код из Excel и отправить данные из Access, вы можете сделать это следующим образом.

Private Sub CommandButton1_Click()
On Error GoTo errH

    Dim con As New ADODB.Connection
    Dim strPath As String
    Dim intImportRow As Integer
    Dim sql As String
    Dim strFirstName, strLastName As String

    'CHANGE PATH TO DATABASE
    strPath = "C:\your_path_here\demo_db.accdb"

    'open the connection to the database
    If con.State <> 1 Then

        con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";"

        con.Open

    End If

    'delete all records first if checkbox checked
    If CheckBox1 Then
        con.Execute "delete from tbl_demo"
    End If

    'set first row with records to import
    'you could also just loop thru a range if you want.
    intImportRow = 3

    Do Until Cells(intImportRow, 4) = ""
        strFirstName = Cells(intImportRow, 4)
        strLastName = Cells(intImportRow, 5)
        strTheDate = Cells(intImportRow, 6)

        'insert row into database
        con.Execute "insert into tbl_demo (firstname, lastname, thedate) values ('" & strFirstName & "', '" & strLastName & "', '" & strTheDate & "')"

        intImportRow = intImportRow + 1
    Loop


    MsgBox "Done Exporting", vbInformation

    con.Close
    Set con = Nothing

Exit Sub

errH:
    MsgBox Err.Description
End Sub

Я протестировал оба образца кода.Оба работали отлично.Убедитесь, что ваш тип данных в таблице доступа - дата / время.