ADODB: UPDATE Excel from Access database

[robertocm]

An example of updating an excel file with a join between excel range and access tables.

expandcollapse popup

#include <Excel.au3>
#include <Array.au3>
#include <MsgBoxConstants.au3>
;#include <WinAPIFiles.au3>

;Permitir unha única instancia da aplicación
#include <Misc.au3>
;_Singleton("ADO_Update_Excel_From_Access", 0)
If _Singleton("ADO_Update_Excel_From_Access", 1) = 0 Then
   MsgBox($MB_SYSTEMMODAL, "Warning", "An occurrence of test is already running")
   Exit
EndIf

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

#===== CONFIG =====
Global $sFilePath = @ScriptDir & "\test.xlsx"
Global $sFilePath2 =  @ScriptDir & "\test.mdb"
Global $testmdb = "[;Database=" & $sFilePath2 & ";PWD=123]"
;~ Global $excel = "[Excel 12.0 Xml;HDR=NO;IMEX=1;DATABASE=" & $sFilePath& "]"
;Global $testsqlserver = "[odbc;Driver={SQL Server};SERVER=10.0.0.99;DATABASE=MyDatabaseName;UID=MyUser;PWD=MyPassword]"

#===== 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 = 3 ;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=" & $sFilePath2 & ";Jet OLEDB:Database Password=123"
;Global $sADOConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & $sFilePath2 & ";Jet OLEDB:Database Password=123"
;Global $sADOConnectionString = 'Driver={Microsoft Access Driver (*.mdb)};Dbq=' & $sFilePath2 & ';uid=;pwd=MyPassword;'
;~ ;Global $sADOConnectionString = 'Provider=SQLOLEDB;Data Source=10.0.0.99;Initial Catalog=MyDatabaseName;User Id=MyUser;Password=MyPassword;'
;~ ;Or if you’re using native client:
;~ ;stConnect = "Provider=SQLNCLI10;Data Source=...

;http://www.connectionstrings.com/
;Xlsx files: Excel 2007 (and later) files with the Xlsx file extension
;[Also valid for] Using the Office 2007 OLEDB driver (ACE 12.0) to connect to older 97-2003 Excel workbooks
;cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & RutaXls & ";Extended Properties=Excel 12.0 Xml;"
Global $sADOConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & $sFilePath & ";Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
;Global $sADOConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & $sFilePath & ";Extended Properties=""Excel 12.0;HDR=NO;IMEX=1"";"
;Global $sADOConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & $sFilePath & ";Extended Properties=Excel 8.0;"
;Global $sADOConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & $sFilePath & ";ReadOnly=0;"

;https://www.w3schools.com/asp/prop_rs_cursorlocation.asp
;A Recordset object inherits this setting from the associated Connection object.
;This property is read-only on an open Recordset object, and read/write on a Connection object or on a closed Recordset object.
$cn.CursorLocation = 2 ;2 adUseServer, 3 adUseClient
$cn.CommandTimeout = 30

;https://stackoverflow.com/questions/31941487/open-adodb-connection-to-excel-file-in-read-only-mode
;try Mode = adModeRead instead
;By the way, do not put adModeRead in the connections string, but just before openning your connection, add this line: rsConn.Mode = adModeRead
;I tried your suggestion, however since in VBA we do not have direct access to the ADODB built-in constants, I set rsCon.Mode = 1
;as defined in the file adovbs.inc located in the folder "C:\Program Files\Common Files\System\ado"
;and although I watched the rsCon.Mode value being set to adModeRead while debugging, I still have the same problem and the application tries to access the file in Write/Edit 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)

$sSQL = "UPDATE (([Sheet1$A2:C11] a" _
  & " INNER JOIN " & $testmdb & ".[Order_Details] b ON a.F1 = b.ID)" _
  & " INNER JOIN " & $testmdb & ".[Orders] c ON b.ID = c.ID)" _
  & " INNER JOIN " & $testmdb & ".[Customers] d ON c.CustomerID = d.ID" _
  & " SET a.F2 = c.OrderDate, a.F3 = d.CompanyName;"
$cn.Execute($sSQL, Default, 1 + 0x80)  ;adCmdText = 1 , adExecuteNoRecords = 0x80

$sSQL = "SELECT F2, F3, Sum(Quantity * UnitPrice) As Amount" _
   & " FROM [Sheet1$A2:C11] AS a INNER JOIN " & $testmdb & ".[Order_Details] b ON a.F1 = b.ID" _
   & " GROUP BY F2, F3" _
   & " ORDER BY F2;"
$rst.Open($sSQL, $cn, $iCursorType, $iLockType, $iOptions) ; Issue the SQL query

If Not $rst.EOF = True Then
   Local $rstArray = $rst.GetRows()
   _ArrayDisplay($rstArray, "Test", "", $ARRAYDISPLAY_NOROW, "", "F1|F2|F3")
   $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(True, False, False, Default, True)
   Global $oAppl = _Excel_Open() ;_Excel_Open(Default, Default, False, Default, Default)
   ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_Open" & @CRLF & "@error = " & @error & ", @extended = " & @extended)
   ;https://www.autoitscript.com/forum/topic/185789-solved-excel_bookopen-without-wait/?do=findComment&comment=1334509

   ;Restaurar en cada arquivo (algún Application.Run pudo cambiar)
   ;$oAppl.EnableEvents = False
   $oAppl.DisplayAlerts = False

   ;~ ;Arquivo non bloqueado
   ;~ Global $iFileExists
   ;~ For $j = 0 To 60
   ;~    $iFileExists = FileExists($sFilePath2)
   ;~    If $iFileExists Then
   ;~     While _WinAPI_FileInUse($sFilePath2)
   ;~        Sleep(1000)
   ;~     WEnd
   ;~     ExitLoop
   ;~    Else
   ;~     Sleep(1000)
   ;~    EndIf
   ;~ Next

   ;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.")

   ;~ Global $oWorkbook = _Excel_BookOpen($oAppl, $sFilePath5, False, True)
   ;~ ;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.")

   ;Sleep(3000)
   ;~ Global $sMessage, $sMessage2
   ;~ SplashTextOn("TitleFoo", $sMessage, 580, 60, 900, 840, 1 + 4, "", 16)
   ;~ For $i = 1 To 10
   ;~    $sMessage = $sMessage & "."
   ;~    $sMessage2 = @TAB & "Pausa " & $sMessage
   ;~    ControlSetText("TitleFoo", "", "Static1", $sMessage2)
   ;~    Sleep(1000)
   ;~ Next

   $oWorkbook.UpdateLinks = 2 ;xlUpdateLinksNever

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

   $oSheet.Range("A1:C1").Font.Bold = True
   $oSheet.Range("A1:A" & $RecCount + 1).NumberFormat = "dd/mm"
   $oSheet.Range("B1:B" & $RecCount + 1).NumberFormat = "@"

   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:C" & $RecCount + 1).Value = $TrstArray

   Global $aArray2D[1][4] = [["Date", "Client", "Amount"]]
   _Excel_RangeWrite($oWorkbook, $oSheet, $aArray2D, $oSheet.Cells(1, 1))
   ;Global $aArray1D[11] = ["ID", "Udes", "Descrip", "Matricula", "Kilos", "Proveedor", "Corredor", "Fecha", "Contrato", "Restan", "Tanque"]
   ;$oSheet.Range("A1:K1").value = $aArray1D
   ;Global $aArray2D[1][6] = [[$rstArray[$i][1], $rstArray[$i][2], $rstArray[$i][3], $rstArray[$i][4], $rstArray[$i][5], $rstArray[$i][6]]]
   ;_Excel_RangeWrite($oWorkbook, $oWorkbook.Activesheet, $aArray2D, $oSheet.Cells($UltimaFila, 1).Resize(1, 6))
   ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_RangeWrite: " & @CRLF & "@error = " & @error & ", @extended = " & @extended)
   ;Global $aArray2D[3][5] = [[11, 12, 13, 14, 15], [21, 22, 23, 24, 25], [31, 32, 33, 34, 35]]
   ;_Excel_RangeWrite($oWorkbook, Default, $aArray2D, "B1")
   ;Local $aArray1D[13] = ["Ped", "Archivo", "Abono", "NomCli", "H+I", "ACIDEZ", "CERAS", "E+U", "aa", "aa", "aa", "aa", "aa"]
   ;$oSheet.Range("A1:M1").value = $aArray1D
   ;$oSheet.Cells(1, 1).Resize(1, 13).value = $aArray1D

   ;_Excel_BookSaveAs($oWorkbook, $sFilePath, $xlOpenXMLWorkbook, True) ;$xlOpenXMLWorkbook  51  ;$xlExcel8  56
   ;_Excel_BookClose($oWorkbook, False)
   ;_Excel_BookClose($oWorkbook, True)
   ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_BookClose: " & $sFilePath & @CRLF & "@error = " & @error & ", @extended = " & @extended)

   ;~ While _WinAPI_FileInUse($sFilePath5)
   ;~    Sleep(1000)
   ;~ Wend
   ;~ Sleep(3000)

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

   ;https://www.autoitscript.com/forum/topic/136414-excel-close-problem/?do=findComment&comment=953433
   ;$oAppl.Application.Quit
   ;$oAppl = ""
   ;https://www.autoitscript.com/forum/topic/166043-close-the-entire-application-of-excel/
   ;https://www.autoitscript.com/forum/topic/166043-close-the-entire-application-of-excel/?do=findComment&comment=1262478
   ;Run(@ComSpec & " /c " & 'taskkill /im excel.exe /f /t', "", @SW_HIDE)
   ;https://www.autoitscript.com/forum/topic/166043-close-the-entire-application-of-excel/?do=findComment&comment=1262830
   ;water / Ok. Let's see if the problem is caused by open/close or by working with a workbook. Could you please try:
   ;#include <Excel.au3>
   ;$oExcel = _Excel_Open(False, False, False, False, True)
   ;$oExcelClose = _Excel_Close($oExcel, False, True)
   ;~ _Excel_Close($oAppl, False, Default)
   ;If @error Then Exit MsgBox(0, "Error", "Error _Excel_Close" & @CRLF & "@error = " & @error & ", @extended = " & @extended)

   ;~ Sleep(1000)

   ;~ ;Check excel closed
   ;~ Local $aProcesses = ProcessList("Excel.exe")
   ;~ ;_ArrayDisplay($aProcesses)
   ;~ If $aProcesses[0][0] > 0 Then
   ;~    ;https://www.autoitscript.com/forum/topic/166043-close-the-entire-application-of-excel/?do=findComment&comment=1263191
   ;~    ;@water, thanks for your help so far, at least we pinned down that it's not a UDF bug. :)
   ;~    ;For now I will use a crude workaround by closing the most recent Excel.exe instance:
   ;~    ProcessClose($aProcesses[$aProcesses[0][0]][1])
   ;~    Sleep(100) ;just to allow some time for the process to definitely close (if it does close)
   ;~ EndIf
Else
   $rst.Close
   $rst = 0 ; Release the recordset object
   $cn.Close ; Close the connection
   $cn = 0 ; Release the connection object
   ;Disconnect

   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

   ;Devolver datos error
   Local $sFilePath = @DesktopDir &  "\error.txt"
   ;Open the file for write access.
   Local $hFileOpen = FileOpen($sFilePath, 2)
   ;If $hFileOpen = -1 Then
     ;MsgBox(0, "", "An error occurred when reading/writing the file.")
   ;EndIf

   FileWrite($hFileOpen, "ADODB COM Error" & Chr(1) & _
          "err.description is: "    & @TAB & $errADODB.description    & Chr(1) & _
          "err.windescription:"     & @TAB & $errADODB.windescription & Chr(1) & _
          "err.number is: "         & @TAB & hex($errADODB.number,8)  & Chr(1) & _
          "err.lastdllerror is: "   & @TAB & $errADODB.lastdllerror   & Chr(1) & _
          "err.scriptline is: "     & @TAB & $errADODB.scriptline     & Chr(1) & _
          "err.source is: "         & @TAB & $errADODB.source         & Chr(1) & _
          "err.helpfile is: "       & @TAB & $errADODB.helpfile       & Chr(1) & _
          "err.helpcontext is: "    & @TAB & $errADODB.helpcontext _
         )

   ;Close the handle returned by FileOpen.
   FileClose($hFileOpen)

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

   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

 

example_files.zip