Exporting Dataset to Excel - vb.net

I have the following bit of code that I have used in the past to export a DataSet generated from the Stored Procedure 'HISTORICAL_COSTS' to Excel.
Dim c As Long = 1
For Each dc As DataColumn In Me.WOCostDataSet. & _
HISTORICAL_COSTS.Columns
.Cells(1, c).Value = dc.ColumnName.ToString
.Cells(1, c).Font.Bold = True
c += 1
Next
Dim i As Long = 2
For Each dr As DataRow In Me.WOCostDataSet.HISTORICAL_COSTS.Rows
c = 1
For Each dc As DataColumn In Me.WOCostDataSet. & _
HISTORICAL_COSTS.Columns
.Cells(i, c).Value = dr.Item(dc.ColumnName).ToString
c += 1
Next
i += 1
Next
I am trying to re-use this code an different but similar application, but, I am running into an issue. The previous use of this code was used on a static table in our dBase generated by the Stored Procedure. And while this basically remains the same for the new application, the requirements now require the stored procedure to have an input parameter to be entered by the user (through VB.net) prior to execution. For a little back-story, you can follow that completed process here - Injecting a Parameter into Stored Procedure.
The application itself does in fact return a fully populated dataset, and I'd like our users to have the ability to export that generated dataset to Excel. So, I set up your prototypical 'EXPORT ME' button to do start the dirty work.
Upon raising the event; Excel opens and only my column names are being reiterated throughout the sheet. But, and here is the problem, the cells representing the row data - are blank.
I have come to the conclusion (I do admit that I may be wrong in this assumption) that the rows are not being populated due to the fact that the Stored Procedure needs an input parameter to do it's thing, and without that parameter there isn't any data to return for each row. Basically meaning that my code just won't work for what I am trying to do.
If I am right in my assumptions, any ideas as to how I might get that parameter into my code above so that the rows will be properly generated.
If I am wrong, well, any input on what be wrong with my logic or the code itself would be greatly appreciated.
Thanks,
Jasoomian
Stan,
Here is the code that generates the dataset:
Try
Dim FBConn As FbConnection
Dim MyConnectionString As String
MyConnectionString = "datasource=" _
& MyServer & ";database=" _
& TextBox4.Text & ";user id=SYSDBA;password=" _
& MyPassword & ";initial catalog=;Charset=NONE"
FBConn = New FbConnection(MyConnectionString)
Dim FBCmd As New FbCommand("HISTORICAL_COSTS", FBConn)
FBCmd.CommandType = CommandType.StoredProcedure
FBCmd.Parameters.Add("#I_PN", FbDbType.VarChar, 40)
FBCmd.Parameters("#I_PN").Value = TextBox1.Text.ToUpper
Dim FBadapter As New FbDataAdapter(FBCmd)
Dim dsResult As New DataSet
FBadapter.Fill(dsResult)
Me.HISTORICAL_COSTSDataGridView.DataSource = dsResult.Tables(0)
Dim RecordCount As Integer
RecordCount = Me.HISTORICAL_COSTSDataGridView.RowCount
Label4.Text = RecordCount
Catch ex As System.Exception
System.Windows.Forms.MessageBox.Show _
("There was an error in generating the DataStream, " & _
"please check the system credentials and try again. " & _
"If the problem persists, please contact your friendly " & _
"local IT department.")
End Try
Stackoverflow kindly suggests that I offer a bounty to anyone answering my question,but, since I don't have enough REP to create a sufficient bounty - does my ever-encompassing gratitude garner any coding love?
A few quick updates:
I tested my application by altering the Stored Procedure to inject the results into a new separate table, and then run my excel export against that table - and it works fine. But, since many people will be using the application at the same time, this is not a viable solution.
So, I am back to believing that there is an issue with this instance of the dataset needing a parameter to run correctly for the export.
Happy to answer any and all questions to the best of my ability.

You conclusion is definitely wrong -- once the dataset is populated the parameter is no longer a factor. I don't see anything obviously wrong with your code and, as you said, it worked elsewhere. I would start by setting a breakpoint and making sure that the dataset contains rows as you expect.

Related

Attempting to dynamically pass parameters to a stored procedure from excel 2013 calling DB2 mainframe

I have a requirement to dynamically pass parameter to a called SP which pulls data from the mainframe.
My excel connection string is:
DRIVER={IBM DB2 ODBC DRIVER};UID=k9751x1;PWD=********;MODE=SHARE;DBALIAS=RISCTEST;
The command text is:
call K9751DB.SP_GETRTSDB_BYDBTSNOPTLIKEDTTM('', '', '','2017-10-01 23:25:59.999999','2')
Connection Properties, for reference
I'm attempting to pass the first 3 parameters: LPARSSID, DBNAME, TSNAME
I've created the following VBA code and assigned an activeX button. The code appears to debug fine. but when I click on the button noting appears to happen.
Private Sub CommandButton1_Click()
Dim LPARSSID As String 'Declare LPARSSID as String
Dim DBNAME As String 'Declare DBNAME As String
Dim TSNAME As String 'Declare TSNAME As String
LPARSSID = Sheets("RTSbyDBTSDTE").Range("B2").Value 'Pass value from cell B2 to LPARSSID variable
DBNAME = Sheets("RTSbyDBTSDTE").Range("B3").Value 'Pass value from cell B3 to DBNAME variable
TSNAME = Sheets("RTSbyDBTSDTE").Range("B4").Value 'Pass value from cell B4 to TSNAME variable`
Pass the Parameters values to the Stored Procedure used in the Data Connection
With ActiveWorkbook.Connections("RISCTEST - ParmPass").ODBCConnection
.CommandText = "call K9751DB.SP_GETRTSDB_BYDBTSNOPTLIKEDTTM('" & LPARSSID & "', '" & DBNAME & "', '" & TSNAME & "','2017-10-01 23:25:59.999999','2')"
ActiveWorkbook.Connections("RISCTEST - ParmPass").Refresh
End With
End Sub
Private Sub CommandButton21_Click()
End Sub
Not sure if ODBCConnection is correct.
I appreciate any suggestions you may have.
Tku,
Jeff A
I have a big Microsoft Access database that I use with our scary old bookkeeping system for running complex reports. It's Access 2007 with an iSeries v6, DB2 SQL, and AS400. I tried using Excel 2007 in thye beginning, but it couldn't handle it. But I'll take a stab anyways...
I'm not certain of the way you're using the With block and the Refresh method. I usually see With blocks used with a property or object. But looking at your With block, there's nothing in it. That may be why nothing happens. It just says...
With <yourcommand>.Refresh
'nothing here
End With
...so it may be doing something, but since the With block is empty, it doesn't do anything with any data that might be returned. And since I don't know what the SP is supposed to do, I can't say. And what I mean is, I'm assuming it is supposed to return some data, because if not and it just does something hidden on the server, you would know because you'd probably have other means to verify the activity.
Instead of using the With block, remove the Refresh command from that block and put the command on a line by itself:
...
Pass the Parameters values to the Stored Procedure used in the Data Connection
ActiveWorkbook.Connections("RISCTEST - ParmPass").ODBCConnection _
.CommandText = "call K9751DB.SP_GETRTSDB_BYDBTSNOPTLIKEDTTM('" & LPARSSID _
& "', '" & DBNAME & "', '" & TSNAME & "','2017-10-01 23:25:59.999999','2')" _
ActiveWorkbook.Connections("RISCTEST - ParmPass").Refresh
End Sub
Sorry; this is long. A second answer to your question, and extension of my first answer. My eyes were tired at the end. Please excuse any strange typos or seemingly missing sentences. If your eyes glaze over halfway through, there's actual working code (I hope) at the end.
Holy cow, this has been a bull to figure out. But I threw on a saddle, and I've been riding it since yesterday morning when I first replied to the OP. I think the issue isn't the strangeness of DB2 (as far as I can figure out yet, lol), but because of the way Excel implements ODBC, SQL, and queries.
I decided to make this a learning exercise. I work in Access w/VBA all day at work, with an occasional foray into Excel, but I never dove in to Excel queries before, and I'm much more familiar with Access VBA for this sort of thing. I've been wading through the No-Help file, VBA Object Explorer, and MSDN online documentation. But it was still monumentally confusing. Then I found this web page, which in the first few paragraphs, gives a perfectly coherent picture of the situation: https://www.cimaware.com/expert-zone/creating-basic-data-reports-with-listobjects-and-querytables
There are multiple layers of Excel UI bling involved, and the VBA object hierarchy for the associated collections & objects can take multiple, sometimes simultaneously abbreviated & parallel forms. It's a bit crazy how Excel throws things all over the place:
1) Excel > Workbook/s > Connections > WorkbookConnection > ODBCConnection
2) Excel > Workbook/s > Worksheet/s > ListObject/s > QueryTable/s
3) Excel > Workbook/s > Worksheet/s > QueryTable/s
4) ListObject > QueryTable > WorkbookConnection
5) QueryTable > WorkbookConnection
I'll explain all these items:
Excel, Workbooks, Workbook, Worksheets, and Worksheet are obvious.
Each Workbook contains the Connections collection for every Worksheet in it.
Connections can have connections of any type, whether it be file-based from TXT or XLS, web-based via HTTP, or the one we're looking at closely here: ODBC.
For some reason Microsoft broke the naming convention and called it a WorkbookConnection, rather than just Connection.
Then we arrive at the ODBCConnection, which has the gorey innards of the ODBC settings.
What can be confusing, all throughout these items, the ODBC connection string and SQL query string are repeated, and sometimes it's hard to tell what property/object links one item to another.
A QueryTable (QT) can be created in two places: contained within a ListObject (LO) or it can live independently right on a worksheet.
When a QT is contained in a LO (as introduced in Excel 2007), that's what gives us some of the bling I mentioned. Specifically, the Table Tools group and Design tab on the ribbon. This is where all the fancy settings & formatting come from, such as the alternating rows colors and dropdown boxes on the column headers.
When a QT is independent from a LO, the resulting query results & controls are simple and utilitarian. In fact they look and work just like they did in Excel 2003.
1) Excel > Workbook/s > Connections > WorkbookConnection > ODBCConnection
This is where the connection is stored. This is equivalent to the connections you see in the "Workbook Connections" window from the ribbon at Data > Connections.
2) Excel > Workbook/s > Worksheet/s > ListObject/s > QueryTable/s
This is what you get when you create a query from scratch in the Excel UI, by using any of the items in the "Get External Data" group that result in an ODBC connection to an SQL server. In my case I already have a collection of DSN files for DB2, so all during this experimentation I've only been using DSN files listed on the "Existing Connections" window.
3) Excel > Workbook/s > Worksheet/s > QueryTable/s
This is what you get if you use VBA to programmatically create a stand-alone QueryTable that's not contained in a ListObject. So far I haven't found any way to do this in the UI; I think no matter what's done, any queries created through the UI of Excel 2007 or later force containment within a ListObject.
4) ListObject > QueryTable > WorkbookConnection
This chain of objects is what you get from the UI. I found the WorkbookConnection need not be explicitly created in the Connections collection ahead of time. Any time a QueryTable is created, the connection is always created as a sort of side product.
5) QueryTable > WorkbookConnection
This is the simplest form, perhaps best described as the old way, and gives a query result and controls like those of Excel 2003 and 2000.
Now, after all this research, I think I understand what's happening in your code, and what you might do differently. The core bit is here:
With ActiveWorkbook.Connections("RISCTEST - ParmPass").ODBCConnection
.CommandText = "call K9751DB.SP_GETRTSDB_BYDBTSNOPTLIKEDTTM('" & LPARSSID & "', '" & DBNAME & "', '" & TSNAME & "','2017-10-01 23:25:59.999999','2')"
ActiveWorkbook.Connections("RISCTEST - ParmPass").Refresh
End With
Cleaned up perhaps like this (in my style of extensive subdivision):
Dim wb As Excel.Workbook
Dim conns As Excel.Connections
Dim conn As Excel.WorkbookConnection
Dim odbc As Excel.ODBCConnection
Dim connName As String
Dim connCmdText As String
Dim spName As String
Dim p1 As String
Dim p2 As String
Dim p3 As String
Dim p4 As String
Dim p5 As String
'Set up the parameter strings for everything.
connName = "RISCTEST - ParmPass"
spName = "K9751DB.SP_GETRTSDB_BYDBTSNOPTLIKEDTTM"
p1 = LPARSSID
p2 = DBNAME
p3 = TSNAME
p4 = "2017-10-01 23:25:59.999999"
p5 = "2"
'I use this trick to make quoted-strings within quoted-strings more
'readable. It's more lines of code, but easy to make with copy &
'paste, and when your eyes get blurry and tired and crossed and those
'double and single quotes start to look like triple single quotes
'and you can't tell quadruple single-quotes from double double-quotes,
'it can be a life saver. =-)
'This is the actual command.
connCmdText = "call spname('p1','p2','p3','p4','p5')"
'Now replace all the parameter codes with the real data. Be careful when
'choosing the names of the codes so they don't conflict with any correct
'strings already in the command string, or mayhem will result. Use goofy
'punctuation to make them more unique if necessary.
connCmdText = VBA.Replace(connCmdText, "spname", spName, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p1", p1, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p2", p2, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p3", p3, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p4", p4, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p5", p5, , , vbTextCompare)
'Now to the business.
Set wb = Excel.ActiveWorkbook
Set conns = wb.Connections
Set conn = conns.Item(connName)
Set odbc = conn.ODBCConnection
odbc.CommandText = connCmdText
conn.Refresh
'The with block wasn't even needed. (I think.)
Now looking at that, I don't see a QT. Is there more to your code that includes one, which you didn't include in your OP..? If the code you posted is all you have, I don't see anything to tell Excel where to put the query result. But unless there's something outstandingly different, you've shown enough to allow some supposition for different code to get what you want.
Here's an actual working procedure for my DB2 system that I worked out today to figure out this issue. It posts a basic Excel 2003-style query result at A1 on Sheet1. I've only blotted out the user credentials and IP of the server for anonymity. This is the most basic implementation of a query in Excel VBA: the independent-QT.
Sub TestQT()
Dim connStr As String
Dim connCmdText As String
Dim destRangeAddr As String
Dim ws As Excel.Worksheet
Dim qts As Excel.QueryTables
Dim qt As Excel.QueryTable
Dim destRangeRng As Excel.Range
'Set up the connection string and other variables for the query.
destRangeAddr = "A1"
connCmdText = "SELECT * FROM VIPDTAB.BEERXT"
connStr = _
"ODBC;" & _
"DRIVER={iSeries Access ODBC Driver};" & _
"UID=********;" & _
"PWD=********;" & _
"SIGNON=1;" & _
"QRYSTGLMT=-1;" & _
"PKG=QGPL/DEFAULT(IBM),2,0,1,0,512;" & _
"LANGUAGEID=ENU;" & _
"DFTPKGLIB=QGPL;" & _
"DBQ=VIPDTAB;" & _
"SYSTEM=***.***.***.***;" & _
"FILEDSN=NOTHING;"
'In experiments I found FILEDSN doesn't need to be anything, it can
'simply be FILEDSN=DUMMY, if you wish to use a DSN-less connections,
'as I do. Also, obviously the password is visible and as such is a
'security issue.
'Define the sheet.
Set ws = ActiveSheet
'Clean up the sheet. Useful if the query is run repeatedly, and to avoid the
'runtime error that says "overlapping pivot table".
ws.Cells.Clear
ws.Cells.ColumnWidth = 8
'Now to business.
Set destRangeRng = ws.Range(destRangeAddr) 'Range object to paste the data.
Set qts = ws.QueryTables 'The QT collection.
Set qt = qts.Add(connStr, destRangeRng, connCmdText) 'Create the query
'Now run it. 'False makes Excel lock up during long queries, so True is best.
qt.Refresh BackgroundQuery:=True
End Sub
Now, to merge all these ideas together to solve your problem. Everything is nearly identical, except the last few lines. I have no way of testing this since of course I'm not on you system, but I did run the debugger on it to catch any blatant typos. So shout me back if you need more help:
Sub TestQuery2()
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim qts As Excel.QueryTables
Dim qt As Excel.QueryTable
Dim conns As Excel.Connections
Dim conn As Excel.WorkbookConnection
Dim destRangeObj As Excel.Range
Dim destRangeTxt As String
Dim connName As String
Dim connDesc As String
Dim connStr As String
Dim spName As String
Dim connCmdText As String
Dim p1 As String
Dim p2 As String
Dim p3 As String
Dim p4 As String
Dim p5 As String
connName = "RISCTEST - ParmPass"
connDesc = "" 'set the description as/if desired
connStr = _
"DRIVER={IBM DB2 ODBC DRIVER};" & _
"UID=k9751x1;" & _
"PWD=********;" & _
"MODE=SHARE;" & _
"DBALIAS=RISCTEST;"
destRangeTxt = "$A$1"
'Set up the procedure call by replacing the parameters.
'It's much more readable than quotes within quotes.
connCmdText = "call spname('p1','p2','p3','p4','p5')"
spName = "K9751DB.SP_GETRTSDB_BYDBTSNOPTLIKEDTTM"
p1 = Sheets("RTSbyDBTSDTE").Range("B2").Value
p2 = Sheets("RTSbyDBTSDTE").Range("B3").Value
p3 = Sheets("RTSbyDBTSDTE").Range("B4").Value
p4 = "2017-10-01 23:25:59.999999"
p5 = "2"
'Replace all the parameters.
connCmdText = VBA.Replace(connCmdText, "spname", spName, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p1", p1, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p2", p2, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p3", p3, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p4", p4, , , vbTextCompare)
connCmdText = VBA.Replace(connCmdText, "p5", p5, , , vbTextCompare)
'Define the worksheet and destination.
Set ws = ActiveSheet
Set destRangeObj = ws.Range(destRangeTxt)
'Clean up the sheet. Useful if query is run repeatedly. If used as
'such, the .Clear has to happen before the .Add method, or a runtime
'error will ocurr due to the old query blocking the new one. I didn't
'save the message, it was something about "pivot table overlap".
ws.Cells.Clear 'wipe all values, formatting, conections, and queries
ws.Cells.EntireColumn.ColumnWidth = 8
'Something I noticed that's different between an LO/QT and independent-QT,
'with an LO/QT, the connection is attached to the table, literally. So the .Clear
'may not delete the connection if it was created by an independent-QT. The following
'bit of code should take care of that, by looping through the connections and
'deleting any connection that already exists with the same name.
Set wb = ws.Parent
Set conns = wb.Connections
For Each conn In conns
If conn.Name = connName Then
conn.Delete
Exit For
End If
Next
'Now the business.
Set qts = ws.QueryTables
Set qt = qts.Add(connStr, destRangeObj, connCmdText)
'Now both the query and connection have been created. The connection name, which
'appears in the Workbook Connections window, needs to be set. When the QT is created
'in the .Add procedure above, the connection is also created, but there's no way to
'specify its name, so it just uses the name "Connection". But that can be changed
'after the fact, as can the connection description, if desired.
Set conn = qt.WorkbookConnection
conn.Name = connName
conn.Description = connDesc
'And finally, the fireworks:
qt.Refresh True
End Sub
spinjector -
First off, let me say WOW... this is amazing stuff and I truly appreciate your taking the time to delve and share.
Secondly, (and quite honestly), you're skills in this area are far and above that of mine. While I've been using excel for many years to pull data from z/OS (my bailiwick as a DBA / SysProg) and have written a few (basic) macros, I've never gotten deep into the bowels as you quite apparently have... IMPRESSIVE.
The method I use to set up my connection is via Data, Other Sources, From MS Query, Choose Data Source, input the query / StoredProc, and assign a taget for the data (see below). Honestly pretty Excel 101, but works well and is fairly easy to implement.
However that being said, I like most techies, love to learn and share and will be attempting what you have shared as time allows. In addition, I'm looking to become more VBA savvy and have discussed some formal (or informal) training with my current management.
Again - your efforts and willingness to share are very much appreciated.
Tku,
Jeff A
To set up excel to use odbc
• Open excel
• Select data
• Select get external data
• Select from other sources
o From SQL Server (for SQL Server)
 Enter server name (ie for dbstatus: xxxxxxxx\xxxx)
 Connect
o From Microsoft Query (For DB2 LUW, z/OS, Oracle)
 Select the data source
 Create a new one if needed
• Name the data source
• Choose the driver type
 Connect
 Enter server name
o Select database / table
o Select view type / display location
o Optionally select properties
 In Command text box, enter query
o OK / OK to run

Inserting data to other xls workbook via ADO & SQL – Data type error

I am building a quite complex UserForm that uses ADO connection to connect to another Excel workbook that serves as a database and retrieve & insert data via SQL queries. Please note I am not allowed to use Access in this case.
I have already figured out how to use SELECT, but there is one particular error with INSERT I can't resolve. That bothers me a lot, I've put a lot of work to it.
First the connection (I use JET for retrieving data and ACE for saving data as I was not able to get JET to work for that):
Public Sub InsertDataToSheet(SQLCmd As String)
Dim cnx As Object
Set cnx = CreateObject("ADODB.Connection")
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source='" & ThisWorkbook.Path & "\Database.xls'; Extended Properties=Excel 12.0;"
cnx.Execute SQLCmd
cnx.Close
End Sub
Then there is a subroutine linked to a Submit button that actually generates the Query as I need to save only filled out Textboxes and Combos to avoid Nulls:
Private Sub SaveRecord()
Dim SQL As String
SQL = "INSERT INTO [Report$A2:AM50000] ("
Dim i As Control
For Each i In Me.controls
If TypeName(i) = "TextBox" Or TypeName(i) = "ComboBox" Then
If i <> e Then SQL = SQL & i.Name & ","
End If
Next i
SQL = Mid(SQL, 1, Len(SQL) - 1) & ") VALUES(" ' Remove last space & comma
Dim j As Control
For Each j In Me.controls
If TypeName(j) = "TextBox" Or TypeName(j) = "ComboBox" Then
If j <> e Then
If j = "Unknown" Then MsgBox "Fire"
Select Case IsNumeric(j)
Case False
SQL = SQL & "'" & j & "'" ' Add single quotes around strings
Case True
SQL = SQL & j
End Select
SQL = SQL & ","
End If
End If
Next j
SQL = Mid(SQL, 1, Len(SQL) - 1) & ")" ' Remove last comma
' Connect
InsertDataToSheet (SQL)
End Sub
There are two particular textboxes in the form that work exactly the same. Normally, users enter numbers to them and everything saves fine (don't mind the '+' buttons):
Sometimes, however, users do not know the values but can't leave those empty. That's when they are supposed to tick the checkboxes to set the value(s) to 'Unknown':
Now there comes the funny part – for the Batch field, it saves fine. But when I set the Shipment ID to 'Unknown' (or any other string), it throws an error:
Note the fields are not Disabled, just Locked with some appearance changes. I was also unable to find any specific details about the error, but it seems there is some problem with the query:
(It says something like 'Incompatible data types in the expression'). The generated query is this:
Any ideas what goes wrong? I'd very much like to keep the functionality as it is know and solve the error rather than redesign it as it already took some effort and the fields can't stay empty.
Never used sql in xls workbooks, but I had this problem with SQL server already. There's nothing "wrong" with your query, the problem is that data type that's accepted on the field of the table you want to insert. Try to turn that field to use text values instead of numbers and it should work.

How can I manually define column types in OLEDB/JET DataTable?

I am importing data from an Excel spreadsheet to a VB.NET DataTable. This Excel spreadsheet has a lot of garbage data in the first 18 rows, including a lot of empty cells. I ultimately remove these rows in post-processing, but I need to access the Excel file as is, without modifying it by hand at all.
I realize that setting IMEX=1 instructs the Jet engine to assume all columns are text. However, I have an issue with setting it to another value (explained more below). So, the default Jet engine column type scan wouldn't work particularly well.
I'd like to either:
Manually define column types before the import
Force Excel to scan many more rows (I believe the default is 8) to determine the column type
However, I do have an issue with idea #2. I do not have administrative rights to open regedit.exe, so I can't modify the registry using that method. I did circumvent this before by importing a key somehow, but I can't remember how I did it. So #1 would be an ideal solution, unless someone can help me carry out idea #2.
Is this possible? Currently, I'm using the following method:
If _
SetDBConnect( _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & filepath & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1""", True) Then
dtSchema = _dh.GetOleDbSchemaTable()
If _dh.Errors <> "" Then
Throw New Exception("::LoadFileToBuffer.GetOleDbSchemaTable::" & _dh.Errors())
End If
For Each sheetRow In dtSchema.Rows
If sheetRow("TABLE_NAME").ToString() = "TOTAL_DOLLARS$" Then
totalDollars = sheetRow("TABLE_NAME").ToString()
ElseIf sheetRow("TABLE_NAME").ToString() = "TOTAL_UNITS$" Then
totalUnits = sheetRow("TABLE_NAME").ToString()
End If
Next
'Get total dollars table
sql.Append("SELECT * FROM [" & totalDollars & "]")
dtDollars = _dh.GetTable(sql.ToString())
End If
Thank you!
You should be able to say:
sql.Append("SELECT * FROM [" & totalDollars & "$A18:X95]")
Where totalDollars is a sheet name and x95 is the last valid row. You will not be able to include headers unless they are available at row 18.

What is correct way to set up VBA ADO connection from Excel to Access for multiple users and files?

I have several excel files that are used for entering data. Files are identical in functionality, one for each service center of ours. In the form there is button that launches a macro which transforms data to table format on another sheet which is then later uploaded to Access db.
Everything worked fine on my own computer. Adding new rows, updating existing rows and deleting existing roles. I had used early binding which lead to problems when I moved files to our network drive. I managed to convert files to late binding but then other problems arose.
Most of the time, uploading to Access isn't working, especially when multiple users try to do stuff at the same time. Most common error code is that I am not using updateable query or that this method doesn't support backwards scrolling. I sorry for not reporting actual error codes, but I can't replicate them at the moment.
My connection code is as follows, it is bit of a mix of copy paste code from different examples.
Opening the connection and other prestuff
Sub excel2access()
Const adUseClient = 3
Const adUseServer = 2
Const adLockOptimistic = 3
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Dim oConn As Object
Dim cmd As Object
Dim rs As Object
Dim r As Long
Dim criteria As String
Dim Rng As Range
Set oConn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source= '" & Range("dbpath").Value & "\" & Range("dbfile").Value & "' ;"
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "Select * from need_rows WHERE service_center = '" & Range("scenter_name").Value & "'", oConn
r = 2 ' the start row in the worksheet
Sheets("data").Select
This following bit looks through data in excel sheet and tries to find match from recordset found for that service center. If match is not found new record is created and if match is found the old record is updated.
Do While Len(Range("A" & r).Formula) > 0
With rs
criteria = Range("D" & r).Value
.Find "identifier='" & criteria & "'"
If (.EOF = True) Or (.BOF = True) Then
.AddNew ' create a new record
.Fields("service_center") = Range("scenter_name").Value
.Fields("product_id") = Range("A" & r).Value
.Fields("quantity") = Range("B" & r).Value
.Fields("use_date") = Range("C" & r).Value
.Fields("identifier") = Range("D" & r).Value
.Fields("file_type") = Range("file_type").Value
.Fields("use_type") = Range("E" & r).Value
.Fields("updated_at") = Now
.Update
Else
If .Fields("quantity") <> Range("B" & r).Value Then
.Fields("quantity") = Range("B" & r).Value
.Fields("updated_at") = Now
.Update ' stores the new record
End If
End If
.MoveFirst
End With
r = r + 1
Loop
rs.Close
Set rs = Nothing
Set oConn = Nothing
MsgBox "Confirmation message"
End Sub
Edit: Based on link by barrowc I changed cursor type to adOpenStatic. I made a test with several users trying to upload data at the same time and everything worked perfectly. Until one user stayed in the file and spent quite a while editing data there and then tried to upload data to db and got following error message: https://dl.dropbox.com/u/3815482/vba_error.jpg
Again, I am back where I started from.
Also, I am open to feedback on my code in general as well.
I am using Office 2010.
Am I doing it wrong? All help is appreciated.
You are going to have a lot of issues with the database being locked by other users. This is for several reasons:
From what I can see you are not handling errors. Therefore if your script errors half way through the connection will be left open thus causing lock problems.
By the looks of this, the macros could potentially keep the connection open for a decent amount of time (assuming no errors).
Having created a lot of macros connecting to an MS Access database I can tell you straight up. You are going to have a lot of connection issues where the database is being locked by spreadsheets that someone has left open all day/night due to things such as not handling unexpected errors (the connection never closes).
Even once you fix the problems all you need is ONE person to be using the spreadsheet with the old code and they will continue to lock the database.
One massive problem is that if someone connects to the database when its already open by someone else I believe they inherit the connection type of the already opened database resulting in a daisy chain of write locks. You then need to make sure all connections are severed in order to reset the connection.
You have also not shown us how the data is put into the spreadsheet in the first place. Perhaps you are not correctly closing the connection and that could potentially be the reason why sometimes the database is locked.
There are many different things you could try to get around this:
Easiest would be to use MS Access Front End + MS Access Back End.
Instead of pressing this button and uploading the data through connection strings you could make it save the file in a folder which would then be processed by an ms access database that is sitting there watching the folder. This would mean that you upload script would be written in MS Access and just be processing the files. Wouldn't be as instantaneous as your current approach but all write connections would be coming from the same machine/user in this circumstance.
Persist with the current method: eventually you may get it to a stable state but it will be a lot of frustration and effort as determining the reason for a lock may not always be easy. You could at least look at who has the file locked at the time and work from there but as mentioned earlier they may not have been the cause of the lock. They may have just inherited the lock type.
Personally I like to use MS Excel to display MS Access data for users, but avoid like a plague getting it to update MS Access. However if I was to do this I would do it through the use of oConn.Execute commands not opening a recordset, comparing and slowing pushing as that would keep the connection open too long.
Sorry for the wall of text. Hope this information helps.
sounds to me like Jet isn't reliable enough for your environment. I frequently use SQL Server / Access Data Projects to consolidate information from multiple spreadsheets into a single database backend that doesn't barf when you add a half dozen users.
You could also try using action queries.
First I would try to update using (you may need to format the now value)
dim count as long
oConn.Execute "UPDATE need_rows SET quantity = " & Range("B" & r).Value & ", updated_at = #" & Now & "# WHERE service_center = '" & Range("scenter_name").Value & "' AND identifier='" & Range("D" & r).Value & "' AND quantity <> " & Range("B" & r).Value", count
If count is zero then no row was updated, so either there was no row to update or the quantity hasn't changed. Either way we can try to INSERT, which will fail in the latter case, but without causing problems.
if count = 0 then
count = oConn.Execute "INSERT ...", count
if count = 0 then
' quantity has not changed, so nothing to do
else
' new record inserted
end if
else
' record updated
end if

Writing Large Amounts of Records to Access using VB

I am currently writing some software in visual studio to analyse large amounts of data from an Access database using SQL. I have code to make a new calculated variable but am struggling with the amount of time it takes to write the data back into Access.
I am currently using some vb com code to communicate with my Access Database which is running in 2002/3 comparability mode. The following is my current code which runs a function in a loop to write to the database.
cnnOLEDB = New OleDbConnection
cnnOLEDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DataDirectoryName & DatabaseFileName
cnnOLEDB.Open()
'cmdOLEDB = New OleDbCommand
cmdOLEDB.Connection = cnnOLEDB
ColumnString = "ID_VAR, ID_PAR, TimeValue, strValue, ID_UPL"
For RecordCounter = 0 To CalcData.GetLength(1) - 1
Var_ID = Var_ID + 1
ValueString = Format(Var_ID, "0") & ", " & Format(Parameter, "0") & ", #" & Date2String(CDate(CalcData(0, RecordCounter))) & "#, " & CalcData(CalcData.GetLength(0) - 1, RecordCounter) & ", " & Format(AsUpload, "0")
If DatabaseConnectionInsert("INSERT INTO " & TableName & " (" & ColumnString & ") VALUES (" & ValueString & ")", "Non-Query") = "Error" Then GoTo Close
Next
cnnOLEDB.Close()
Here is the Function:
Public Function DatabaseConnectioninsert(ByVal Query As String, ByVal Task As String) As String
'On Error GoTo Err
'If cnnOLEDB.State = ConnectionState.Open Then cnnOLEDB.Close()
cmdOLEDB.CommandText = Query
Select Case Task
Case "Read Recordset"
rdrOLEDB = cmdOLEDB.ExecuteReader()
DatabaseConnectioninsert = "Read Recordset"
Case "Read Scalar"
DatabaseConnectioninsert = cmdOLEDB.ExecuteScalar
Case "Non-Query"
cmdOLEDB.ExecuteNonQuery()
DatabaseConnectioninsert = "Non-Query"
End Select
Exit Function
Err:
MsgBox("Database connection error.")
DatabaseConnectioninsert = "Error"
End Function
I am currently trying to insert ~4500 records into the Access Database for each Parameter which takes ~3minutes. However when the project goes live it will have to deal with over 100000 records per Parameter so it is no where near fast enough.
To solve this issue I am thinking of either updating my code to .net or creating a record set, so I can move all of the data in Access at once. Can anyone give me some advice as to which will have the greatest impact to improving the speed of the inserts. I am running visual studio 2005 and Access 2007, updating the database to 2007 rather than compatibility mode is possible but not ideal , however my current code can't access it.
Thank you for your help
Josh
As ridiculous as it sounds, the very best performance you will get on an Access database is using the ancient DAO COM library. Use a RecordSet object to add the records one at a time in a loop and reference the fields by their index (ordinal position) rather than their names. You will find it much, much quicker than using oleDB.ExecuteNonQuery.
See the solution given here for more information. It's C# but it's easy enough to follow and convert to VB.NET if you want to try it out.
Edit
In deference to Remou's comments below: it would appear that Microsoft have in fact been keeping DAO technology up to date – in spite of declaring it obsolete back in 2002 – but you have to use the Office Access Redistributable rather than the better known DAO 3.6 library.