January 12, 2010
Let’s say that there is an Excel spreadsheet containing a list of customer order IDs in column A, and you would like to query an Oracle database using the value in column A, and then display a message on the screen showing the results of the query. The following macro code will do just that:
Sub CheckSpreadsheet() Dim dbMyDB As New ADODB.Connection Dim snpData As New ADODB.Recordset Dim intLastRowChecked Dim intFoundFirstBlank Dim intResult As Integer Dim intColumn Dim strColumn Dim strFilename Dim strWorkbookname Dim strSheet Dim strExcelValue Dim strSQL Dim strMessage 'You must create a reference to Microsoft ActiveX Data Objects (Tools menu) 'Make sure that we don't crash - will look ugly if our macro crashes On Error Resume Next 'Replace MyODBCConnection with an ODBC connection name, MyUserName with a database user name and MyPassword with the user's password dbMyDB.ConnectionString = "Data Source=MyODBCConnection;User ID=MyUserName;Password=MyPassword;" dbMyDB.ConnectionTimeout = 40 dbMyDB.CursorLocation = adUseClient dbMyDB.Open strWorkbookname = Right(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) -InStrRev(ActiveWorkbook.FullName, "\")) strSheet = ActiveSheet.Name intLastRowChecked = 1 'Set to skip the first row intColumn = 65 'Column A strColumn = Chr(intColumn) Do While intFoundFirstBlank = False intLastRowChecked = intLastRowChecked + 1 'Read the value from the spreadsheet strExcelValue = Format(Workbooks(strWorkbookname).Worksheets(strSheet).Range(strColumn & Format(intLastRowChecked)).Value) If strExcelValue = "" Then intFoundFirstBlank = True Else 'Could perform an INSERT statement rather than a SELECT statement strSQL = "SELECT" & vbCrLf strSQL = strSQL & " LINE_NO," & vbCrLf strSQL = strSQL & " PART_ID," & vbCrLf strSQL = strSQL & " ORDER_QTY," & vbCrLf strSQL = strSQL & " DESIRED_SHIP_DATE" & vbCrLf strSQL = strSQL & "FROM" & vbCrLf strSQL = strSQL & " CUST_ORDER_LINE" & vbCrLf strSQL = strSQL & "WHERE" & vbCrLf strSQL = strSQL & " CUST_ORDER_ID='" & strExcelValue & "'" & vbCrLf strSQL = strSQL & "ORDER BY" & vbCrLf strSQL = strSQL & " DESIRED_SHIP_DATE" snpData.Open strSQL, dbMyDB Do While Not snpData.EOF strMessage = strExcelValue & "/" & Format(snpData("line_no")) & " " & Format(snpData("desired_ship_date"), "m/d/yyyy") & _ " " & snpData("part_id") & " Qty " & Format(snpData("order_qty")) MsgBox strMessage snpData.MoveNext Loop snpData.Close End If Loop Set snpData = Nothing dbMyDB.Close Set dbMyDB = Nothing End Sub
Note that there are a couple minor issues with the above script:
- The script runs until it finds a blank cell in column A, rather than using an Excel feature to identify the bounds of the range.
- The script requires an ODBC (32 bit) to be created on the computer. Search the other articles on this blog to see how to establish a connection to the database without creating an ODBC connection.
- The script does not use bind variables. Search the other articles on this blog to see how to implement bind variables in an Excel macro.
By changing the script slightly, the SELECT statement could be modified to be an UPDATE statement, allowing an easy method to update the database based on data contained in the Excel spreadsheet.