ole db CopyFromRecordset skipping cell values

Clif McIrvin

New Member
Joined
Dec 22, 2023
Messages
11
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I'm using OLE DB CopyFromRecordset and getting empty cells where there should be text.
My connection string is supposed to be disabling the automatic type guessing, but it looks like that's not happening. For instance: row 1 has a floating point value, rows 2-12 are empty, row 13 is text, following rows are either numbers or empty. Row 12 is coming across as an empty cell.
What am I doing wrong?
My connection string is:
VBA Code:
Provider=Microsoft.ACE.OLEDB.12.0;Data Source=S:\RMix\7. RM_QC Info\4.840AF\_4.840AF_table.xlsx;Extended Properties="Excel 12.0 Xml;HDR=No;IMEX=1";
The connection object ConnectionString property is
VBA Code:
Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=S:\RMix\7. RM_QC Info\4.840AF\_4.840AF_table.xlsx;Mode=Share Deny None;Jet OLEDB:System database="";Jet OLEDB:Registry Path="";Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False;

I'm using (modified) code from Rob Bovey to open the recordset - here are the working pieces of the code:
VBA Code:
Dim Connection   As ADODB.Connection
Dim rs           As ADODB.Recordset
Dim strRequest   As String
Dim colSheetList As Collection
Dim LongName        As String
Dim src       As Worksheet
Dim idx      As Long

' get collection of sheet names in LongName
    Set colSheetList = GetSheetNames(LongName, objConnection:=Connection, _
        bPlainText:=True) 'add "$" for SELECT statement

''To read an entire sheet:
'strRequest = "SELECT * FROM Sheet1$"

    Set rs = New ADODB.Recordset
    For idx = 1 To colSheetList.Count

        strRequest = "SELECT * FROM [" & colSheetList(idx) & "$]"
        sz = "Unknown format"
        On Error Resume Next
        rs.Open strRequest, Connection, adOpenForwardOnly, adLockOptimistic, adCmdText
        err_ = Err.Number
        On Error GoTo 0
        If err_ = 0 Then
            src.Cells(1).CopyFromRecordset rs 'import worksheet
        End If
VBA Code:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' Comments:   Returns a collection containing the list of worksheets in
'''             the specified workbook. Optionally returns the open connection.
'''             NOTE: Requires references to the following object library:
'''             * Microsoft ActiveX Data Objects 2.5 Library (or higher version)
'''
''' Arguments:  szFullName      [in] Optional full path and filename of the
'''                             workbook whose worksheet list you want to query.
'''             objConnection   [in] Optional open Connection
'''                             [out] open connection
'''             bPlainText      [in] Optional return names as plain text
'''                             False to retain SELECT formatting
'''
''' Date        Developer       Action
''' --------------------------------------------------------------------------
''' 05/13/05    Rob Bovey       Created
''' 04/17/18    Clif McIrvin    Tweaked to use GetExcelConnection
'''                             or optionally already open connection
''' 08/03/19    Clif McIrvin    converted to return collection not array
'''
Public Function GetSheetNames( _
    Optional ByRef szFullName As String, _
    Optional ByRef objConnection As Object, _
    Optional ByVal bPlainText As Boolean = True) As Collection

    Dim colSheetNames As Collection
    Dim bIsWorksheet As Boolean
    Dim bCloseConnection As Boolean
    Dim rsData As ADODB.Recordset
    Dim szSheetName As String

    Set colSheetNames = New Collection
    Select Case True 'lazy evaluation
    Case objConnection Is Nothing, objConnection.State = adStateClosed
        If szFullName = "" Then Exit Function 'name or connection required
        'bCloseConnection = True
        Set objConnection = GetExcelConnection(szFullName)
    End Select
    Set rsData = objConnection.OpenSchema(adSchemaTables)

    Do While Not rsData.EOF
        bIsWorksheet = False
        szSheetName = rsData.Fields("TABLE_NAME").Value
        If Right$(szSheetName, 1) = "$" Then
            ''' This is a simple sheet name. Remove the trailing "$" and continue.
            If bPlainText Then
                szSheetName = Left$(szSheetName, Len(szSheetName) - 1)
            End If
            bIsWorksheet = True
        ElseIf Right$(szSheetName, 2) = "$'" Then
            ''' This is a sheet name with spaces and/or special characters.
            If bPlainText Then
                ''' Remove the right "&'" characters.
                szSheetName = Left$(szSheetName, Len(szSheetName) - 2)
                ''' Remove the left single quote character.
                szSheetName = Right$(szSheetName, Len(szSheetName) - 1)
                ''' Embedded single quotes in the sheet name will be doubled up.
                ''' Replace any doubled single quotes with one single quote.
                szSheetName = Replace$(szSheetName, "''", "'")
            End If
            bIsWorksheet = True
        End If
        If bIsWorksheet Then
            ''' Add the processed sheet name to the collection.
            colSheetNames.Add szSheetName
        End If
        rsData.MoveNext
    Loop

    rsData.Close
    Set rsData = Nothing
    If bCloseConnection Then
        objConnection.Close
        Set objConnection = Nothing
    End If
    Set GetSheetNames = colSheetNames
    Set colSheetNames = Nothing
End Function
VBA Code:
'GetExcelConnection Code modified from
'http://www.xtremevbtalk.com/969621-post3.html?s=234e2943e4f38f3802351c80c94145c7
'Always open as text (IMEX=1)
Private Function GetExcelConnection(ByVal szFullName As String, _
    Optional ByVal Headers As Boolean = False) As Connection

Dim objConnection As ADODB.Connection
Dim szConnect As String

Const Provider      As String = "Provider=Microsoft.ACE.OLEDB.12.0;"
Const DataSource    As String = "Data Source=" 'c:\myFolder\myExcel2007file.xlsm;
Const EP1           As String = ";Extended Properties=""Excel 12.0"
Const EP2Macro      As String = " Macro"
Const EP2xml        As String = " Xml"
Const EP_HDR        As String = ";HDR="
Const EP_IMEX       As String = ";IMEX=1"";"

Dim EP2 As String 'Extended Properties Type Field

    Select Case Right(szFullName, 5)
        Case ".xlsx"
            EP2 = EP2xml
        Case ".xlsm"
            EP2 = EP2Macro
        Case Else '.xls, .xlsb, ???
            EP2 = ""
            If InStrRev(szFullName, ".xlt", -1, vbTextCompare) <> 0 Then
                Exit Function ' ignore template files
            End If
    End Select
    
    szConnect = Provider & DataSource & szFullName & EP1 & EP2 & _
              EP_HDR & IIf(Headers, "Yes", "No") & EP_IMEX
    
    Set objConnection = New ADODB.Connection
    objConnection.Open szConnect
    Set GetExcelConnection = objConnection
    Set objConnection = Nothing
End Function
Screenshot 2023-12-22 125309.png

Screenshot 2023-12-22 125613.png
Code:
 INFO.BAT version 1.6
--------------------------------------------------------------------------------
Windows version        :  Microsoft Windows [Version 10.0.19045.3803]
Product name           :  Windows 10 Enterprise for Virtual Desktops, 64 bit
Performance indicators :  Processor Cores: 8      Visible RAM: 33553972 kilobytes

Date/Time format       :  (mm/dd/yy)  Fri 12/22/2023  12:56:58.37
__APPDIR__             :  C:\WINDOWS\system32\
ComSpec                :  C:\WINDOWS\system32\cmd.exe
PathExt                :  .COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC
Extensions             :  system: Enabled   user: Disabled
Delayed expansion      :  system: Disabled  user: Disabled
Locale name            :  en-US       Code Pages: OEM  437    ANSI 1252
DIR  format            :  12/19/2023  07:31 PM     5,754,892,288 pagefile.sys
Permissions            :  Elevated Admin=No, Admin group=No

                          Missing from the tool collection:  debug
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Forum statistics

Threads
1,223,879
Messages
6,175,148
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top