Clif McIrvin
New Member
- Joined
- Dec 22, 2023
- Messages
- 11
- Office Version
- 365
- 2016
- Platform
- 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:
The connection object ConnectionString property is
I'm using (modified) code from Rob Bovey to open the recordset - here are the working pieces of the code:
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";
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
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