Force ADODB.Connection in Excel Write Cells to be numbers instead of strings

[Qwerty212]

Hello from Barcelona.

I've been searching in the forum and in the net but I haven't find a solution for my problem.

I'm trying to fill an Excel file with values but, even formatting the cells as Numbers, every time that I write some data with this function

Func _ADOExcel_CellWrite($col, $row, $value, $tab)
    Local $ADO_Recordset = ObjCreate("ADODB.Recordset")
    Local $ADO_SQL_Query = "Select * FROM [" & $tab & "$]"

    $ADO_Recordset.Open($ADO_SQL_Query, $ADO_Connection, $ADO_adOpenKeyset, $ADO_adLockOptimistic, $ADO_adCmdText)
    $ADO_Recordset.Move($row - 1)
    $ADO_Recordset.Update($col - 2, Number($value)).NumberFormat = "0"
    $ADO_Recordset.Close

EndFunc   ;==>_ADOExcel_CellWrite

When I open the Excel file manually, it shows an error on each cell with a number, claiming that there is a number stored as text in it.

I have searched in the help file and the examples provided are focused to read data from the Excel files doing querys, but I can't not find an example of how to write data to a cell forcing the format.

Could someone provide an example of how to write data to a cell forcing it to be an integer or a string?

Is it possible to combine this two kinds of data when filling an Excel file with an ADO connection?

I've been reading about the IMEX paramether when you do the connetion string, but I've been doing test changing the IMEX from 0 to 3 and nothing changes.

Any help would be trully aprecciated

 

PS: I attach the Excel file that I'm trying to fill

Excel_Example.xlsx

[robertocm]

I would suggest to avoid using ADODB for writing excel

I'm using GetRows and writing the array with Excel UDF

expandcollapse popup

#include <Excel.au3>
#include <Array.au3>

Opt("MustDeclareVars", 1)
Opt("TrayIconDebug", 1)
OnAutoItExitRegister("OnAutoItExit")

Global $sFilePath =  @ScriptDir & "\Northwind.mdb"

#===== ADODB =====
Global $cn, $rst, $sSQL, $SubSQL

;Help: COM Error Handling
;_ErrADODB From spudw2k
;https://www.autoitscript.com/forum/topic/105875-adodb-example/
Global $errADODB = ObjEvent("AutoIt.Error","_ErrADODB")

Global Const $iCursorType = 3 ;0 adOpenForwardOnly, 3 adOpenStatic
Global Const $iLockType = 1 ;1 adLockReadOnly, 3 adLockOptimistic
Global Const $iOptions = 1 ; Options, 1 Evaluates as a textual definition of a command or stored procedure call ; 2 adCmdTable
$cn = ObjCreate("ADODB.Connection") ; Create a connection object
$rst = ObjCreate("ADODB.Recordset") ; Create a recordset object
Global $sADOConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & $sFilePath & ";Jet OLEDB:Database Password=123"
;Global $sADOConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & $sFilePath & ";Jet OLEDB:Database Password=123"
;Global $sADOConnectionString = 'Driver={Microsoft Access Driver (*.mdb)};Dbq=' & $sFilePath & ';uid=;pwd=MyPassword;'

;https://www.w3schools.com/asp/prop_rs_cursorlocation.asp
$cn.CursorLocation = 2 ;2 adUseServer, 3 adUseClient
$cn.CommandTimeout = 60

;https://stackoverflow.com/questions/31941487/open-adodb-connection-to-excel-file-in-read-only-mode
;https://www.w3schools.com/asp/prop_rec_mode.asp
$cn.Mode = 1 ;Read-only

$cn.Open($sADOConnectionString) ; Open the connection
;MsgBox(0,"",$cn.ConnectionString)

;PROVEEDORES_SUMA_KILOS_PEDIDOS_COMPRA_POR_ACEITE_2020.xlsx
$sSQL = "SELECT [Order Details].OrderID, Products.ProductName, [Order Details].UnitPrice, [Order Details].Quantity, [Order Details].Discount" _
   & " Products INNER JOIN [Order Details] ON Products.ProductID = [Order Details].ProductID" _
   & " ORDER BY [Order Details].OrderID" _
$rst.Open($sSQL, $cn, $iCursorType, $iLockType, $iOptions) ; Issue the SQL query

If Not $rst.EOF = True Then
   Local $rstArray = $rst.GetRows()
   ;_ArrayDisplay ($rstArray, "", "", $ARRAYDISPLAY_NOROW, "", "OrderID|ProductName|UnitPrice|Quantity|Discount")
   $rst.Close
   $rst = 0 ;Release the recordset object
   ;$cmd = 0
   $cn.Close ;Close the connection
   $cn = 0  ;Release the connection object

   Global $RecCount = UBound($rstArray)

   #===== EXCEL =====
   Global $oMyError = ObjEvent("AutoIt.Error", "ErrFunc") ;Install a custom error handler
   Global $iEventError ; to be checked to know if com error occurs. Must be reset after handling.
   ;_DebugSetup()
   ;_DebugCOMError()
   ;water: force the Excel UDF to always start up a new instance by using: _Excel_Open(False, Default, Default, Default, True)
   ;~ Global $oAppl = _Excel_Open(False, Default, Default, Default, True)
   Global $oAppl = _Excel_Open()
   ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_Open" & @CRLF & "@error = " & @error & ", @extended = " & @extended)
   $oAppl.EnableEvents = False
   ;~ $oAppl.DisplayAlerts = False

   ;~ Global $oWorkbook = _Excel_BookOpen($oAppl, $sFilePath2)
   ;~ ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_BookOpen: " & $sFilePath & @CRLF & "@error = " & @error & ", @extended = " & @extended)
   ;Create a new workbook with only 1 worksheet
   Global $oWorkbook = _Excel_BookNew($oAppl, 1)
   ;If @error Then Exit MsgBox(0, "Excel UDF: _Excel_BookNew Example 1", "Error creating new workbook." & @CRLF & "@error = " & @error & ", @extended = " & @extended)
   ;MsgBox(0, "Excel UDF: _Excel_BookNew Example 1", "Workbook has been created successfully with only 1 worksheets.")

   ;~ ;only for testing printareas lost
   ;~ ;$oWorkbook.Saved = False
   ;~ ;Restore print areas
   ;~ Global $Name ='', $Ref = '', $pAreas = 0
   ;~ For $nm In $oWorkbook.Names
   ;~    $Name = $nm.Name
   ;~    $Ref = $nm.RefersTo
   ;~    ;Deleting names with invalid references
   ;~    ;http://www.datawright.com.au/excel_resources/excel_range_names_vba.htm
   ;~    If StringInStr($Ref, "#¡REF") > 0 Then
   ;~     Consolewrite("--> Deleting: " & $Name & @TAB & $aFileList[$i] & @CRLF)
   ;~     $nm.Delete
   ;~     If $iEventError Then
   ;~         Consolewrite("Error in Deleting Names with invalid references: " & $Name & @TAB & $aFileList[$i] & @CRLF)
   ;~         $iEventError = 0 ; Reset after displaying a COM Error occurred
   ;~     EndIf
   ;~    ElseIf StringInStr($Name, "Print_Area") > 0 Then
   ;~     $pAreas += 1
   ;~     If StringInStr($Ref, " ") = 0 Then
   ;~        $oWorkbook.Sheets(StringSplit($Name, "!")[1]).Names.Add("Área_de_impresión", $Ref)
   ;~     Else
   ;~        $oWorkbook.Sheets(StringSplit(StringReplace($Name, "'", ""), "!")[1]).Names.Add("Área_de_impresión", $Ref)
   ;~     EndIf
   ;~     ;Consolewrite(@TAB & "--> Deleting:  " & $Name & @TAB & $aFileList[$i] & @CRLF)
   ;~     If $iEventError Then
   ;~         Consolewrite(@TAB & "Error creating 'Área_de_impresión' " & $Ref & "  " & $aFileList[$i] & @CRLF)
   ;~         $iEventError = 0 ; Reset after displaying a COM Error occurred
   ;~     EndIf
   ;~     $nm.Delete
   ;~     If $iEventError Then
   ;~         Consolewrite(@TAB & "Error in Deleting Print_Area Names:  " & $aFileList[$i] & @CRLF)
   ;~         $iEventError = 0 ; Reset after displaying a COM Error occurred
   ;~     EndIf
   ;~    EndIf
   ;~ Next
   ;If $pAreas = 0 Then Consolewrite("Error Lost All Print Areas:  " & $aFileList[$i] & @CRLF)
   ;~        ;Restore print areas: another option, but slower
   ;~        ;Check if range name exists
   ;~        Global $ShName = '', $Sheets = $oWorkbook.Sheets
   ;~        For $ws In $Sheets
   ;~           $ShName = $ws.Name
   ;~           If Not IsObj($oWorkbook.Sheets($ShName).Evaluate("Área_de_impresión")) Then
   ;~           ;If Not IsObj($oWorkbook.Sheets($ShName).Range("Área_de_impresión")) Then
   ;~              If IsObj($oWorkbook.Sheets($ShName).Evaluate("Print_Area")) Then
   ;~                  $oWorkbook.Sheets($ShName).Names.Add("Área_de_impresión", "=" & $oWorkbook.Sheets($ShName).Range("Print_Area").Address)
   ;~                  $oWorkbook.Sheets($ShName).Names.Add("Print_Area", "")
   ;~                  ;$oWorkbook.Sheets($ShName).Names("Print_Area").Delete
   ;~               EndIf
   ;~            EndIf
   ;~        Next

   Global $oSheet = $oWorkbook.ActiveSheet
   ;Global $oSheet = $oWorkbook.Sheets("Sheet1")
   ;MsgBox(0, "", $oSheet.Name)


   ;$oSheet.Columns(1).ColumnWidth = 4.36
   ;$oSheet.Columns("I:L").ColumnWidth = 4
   $oSheet.Columns(2).ColumnWidth = 8
   $oSheet.Columns("C").ColumnWidth = 38
   $oSheet.Columns("D").ColumnWidth = 20
   $oSheet.Columns(5).ColumnWidth = 10
   ;$oSheet.Range("H2:H" & RecCount + 1).WrapText = True
   ;$oSheet.Range("H2:H" & RecCount + 1).Font.Size = 8
   ;$oSheet.Range("A2:M" & RecCount + 1).VerticalAlignment = -4160
   $oSheet.Range("B2:B" & $RecCount + 1).NumberFormat = "@"
   $oSheet.Range("C2:C" & $RecCount + 1).NumberFormat = "#.##0"
   $oSheet.Cells(1, 1).Resize(1, 5).Font.Bold = True
   ;$oSheet.Cells(1, 1).Resize(1, 5).AutoFilter

   Global $oPageSetup = $oSheet.PageSetup
   With $oPageSetup
      .PrintTitleRows = "$1:$1"
      .PrintTitleColumns = ""
      .PrintArea = ""
      .LeftHeader = "&D"
      .CenterHeader = "Report"
      .RightHeader = "&P of &N"
      ;.LeftFooter = "&F {&A}"
      .CenterFooter = ""
      .RightFooter = ""
      .LeftMargin =  28
      .RightMargin =  28
      .TopMargin =  28
      .BottomMargin =  28
      .HeaderMargin =  15
      .FooterMargin =  15
      .PrintHeadings = False
      .PrintGridlines = True
      .PrintComments = -4142
      .CenterHorizontally = False
      .CenterVertically = False
      .Orientation = 1 ;2
      .Draft = False
      .FirstPageNumber = -4105
      .Order = 1
      .BlackAndWhite = True
      .Zoom = 100
   EndWith

   ;https://www.autoitscript.com/forum/topic/195252-_excel_rangewrite-doesnt-write-array-from-adodb-getrows/
   Global $TrstArray = $rstArray
   _ArrayTranspose($TrstArray)
   $oSheet.Range("A2:E" & $RecCount + 1).Value = $TrstArray

   Global $aArray2D[1][5] = [["OrderID", "ProductName", "UnitPrice", "Quantity", "Discount"]]
   _Excel_RangeWrite($oWorkbook, $oSheet, $aArray2D, $oSheet.Cells(1, 1))

   $oAppl.EnableEvents = True
   ;$oAppl.DisplayAlerts = True

   ;_Excel_BookSaveAs($oWorkbook, $sFilePath, $xlOpenXMLWorkbook, True) ;$xlOpenXMLWorkbook  51  ;$xlExcel8  56
   ;_Excel_BookClose($oWorkbook, False)
   ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_BookClose: " & $sFilePath & @CRLF & "@error = " & @error & ", @extended = " & @extended)
Else
   $rst.Close
   $rst = 0 ; Release the recordset object
   $cn.Close ; Close the connection
   $cn = 0 ; Release the connection object

   MsgBox(262144, "", "Empty Recordset", 5)
EndIf

;This is a custom error handler
Func ErrFunc()
   Local $HexNumber = Hex($oMyError.number, 8)
;~    MsgBox(0, "", "We intercepted a COM Error !" & @CRLF & _
;~       "Number is: " & $HexNumber & @CRLF & _
;~       "WinDescription is: " & $oMyError.windescription)
   ConsoleWrite("->    We intercepted a COM Error !" & @CRLF & _
   "->    err.number is: " & @TAB & $HexNumber & @CRLF & _
   "->    err.source: " & @TAB & $oMyError.source & @CRLF & _
   "->    err.windescription: " & @TAB & $oMyError.windescription & _
   "->    err.scriptline is: " & @TAB & $oMyError.scriptline & @CRLF)

   $iEventError = 1 ; Use to check when a COM Error occurs
EndFunc   ;==>ErrFunc

Func _ErrADODB()
   Msgbox(0,"ADODB COM Error","We intercepted a COM Error !"      & @CRLF  & @CRLF & _
       "err.description is: "    & @TAB & $errADODB.description    & @CRLF & _
       "err.windescription:"     & @TAB & $errADODB.windescription & @CRLF & _
       "err.number is: "         & @TAB & hex($errADODB.number,8)  & @CRLF & _
       "err.lastdllerror is: "   & @TAB & $errADODB.lastdllerror   & @CRLF & _
       "err.scriptline is: "     & @TAB & $errADODB.scriptline     & @CRLF & _
       "err.source is: "         & @TAB & $errADODB.source         & @CRLF & _
       "err.helpfile is: "       & @TAB & $errADODB.helpfile       & @CRLF & _
       "err.helpcontext is: "    & @TAB & $errADODB.helpcontext, 5)

   Local $err = $errADODB.number
   If $err = 0 Then $err = -1

   $rst = 0
   ;$cmd = 0
   $cn.Close
   $cn = 0

   Exit
EndFunc

Func OnAutoItExit()
   $rst = 0 ;Release the recordset object
   If IsObj($cn) Then
      If $cn.State > 0 Then $cn.Close ;adStateOpen Close the connection
      $cn = 0 ; Release the connection object
   EndIf
EndFunc

 

[Qwerty212]

Hi @robertocm, thanks for your answer.

 

Actually I'm using the Excel UDF, but it is slower compared with ADODB

[robertocm]

Another idea could be converting to numbers after writing with PasteSpecial,

translating something like this (VBA code, value of cell B1 = 1)

Range("B1").Copy
Range("A1:A4").PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply

Edited August 29, 2020 by robertocm