As stated in the title,
I have a web application where user supposed to upload an excel file,
the system will then read it and put it inside a recordset, then it will loop it to read one by one data to be processed into database.
Problem is, it can process small data just fine, but when I try to process around 919 record, it stuck at around 890 record and the application pool just stopped by itself, I'm guessing it crashed.
I've tried putting response.flush for every 100 record to no avail. Running the process inside the server itself gives me this error around 890 record,
An unhandled win32 exception occurred in w3wp.exe.
Thanks in advance.
The code is in classic asp, vbscript
My Initial Code :
Set objConn = Server.CreateObject("ADODB.Connection")
dim tmpRS
objConn.open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & folderPath & "\" & fname_ & "; Extended Properties='Excel 8.0;HDR=No'"
Set cat = Server.CreateObject("ADOX.Catalog")
cat.ActiveConnection = objConn
For tnum = 0 To cat.Tables.count - 1
Set tbl = cat.Tables(tnum)
set objRS = server.createObject("ADODB.recordset")
objRS.Open "SELECT * FROM [" & tbl.Name & "]" , objConn
if objRs.eof = false Then
set tmpRS = mydb("INSERT INTO tmpTable VALUES ('" & TRIM(objrs.fields.item(0)) & "')", 3)
set tmpRS = nothing
end if
set objrs = nothing
Next
objConn.close
Current Solution That I Found :
Set objConn = Server.CreateObject("ADODB.Connection")
dim tmpRS
objConn.open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & folderPath & "\" & fname_ & "; Extended Properties='Excel 8.0;HDR=No'"
set objRS = server.createObject("ADODB.recordset")
objRS.Open "SELECT * FROM [Sheet1$]" , objConn
if objRs.eof = false Then
set tmpRS = mydb("INSERT INTO tmpTable VALUES ('" & TRIM(objrs.fields.item(0)) & "')", 3)
set tmpRS = nothing
end if
set objrs = nothing
I would be very grateful if someone can point out what is the problem with my initial code.
Related
We are having an important issue at my organization right now. Up to this point (and since it is a small business) they have been using an Excel macro-enabled file with some forms coded in VBA to record sales, expenses, manage inventory, etc. Although it is not the best solution, so far it has been doing the job. Now, they'd like to implement a second computer to manage the business "database" simultaneously.
The first thing I thought was to share the Workbook locally through the legacy Share function in Excel and force the file to refresh before the VBA code makes any change to avoid entry duplication in the tables. However, this functionality is very limited and can't refresh the Workbook as often as I'd like.
I searched for a few days and found a few "band-aid" solutions for this using just Excel and some web query, but that just seems destined to fail. So, what I thought could be a viable solution is to link the exact same Excel file on more computers to the same Access database, which will be a lot easier to manage. I found out that Access offers the function to link an Excel file to a database, and any changes made to original Excel file will be automatically updated in the database. Then, you can also retrieve the data from said database back to Excel to keep everything updated on all computers. I believe if there would be a way to link the Excel file on every computer to the same Access database which will be hosted locally, and then update Excel back before making any new changes this could work. My problem is that, even though all tables have the same name (they belong to the same Excel file), Access decides to use only one source to manage the database.
Basically, I'd like to use and Excel macro-enabled file as the front-end interface, and Access as the back-end database. I'm well aware that this, by far, isn't the best solution, but it'll be a while before we have the time and resources to make a proper database using SQL. I would highly appreciate any suggestions to sort this out. I'm also aware of the risks involved, but considering that no more than 4 computers would be connected at the same time I believe the risks wouldn't be as high as trying to do this at a corporate level.
Take a look at the sample code below and feel free to modify anything to suit your needs.
Sub ImportDataFromExcel()
Dim rng As Range
Dim r As Long
Dim conn As ADODB.Connection
Dim strConn As String
Dim strSQL As String
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
"C:\Users\Ryan\Desktop\Coding\Integrating Access and Excel and SQL Server\Access & Excel & SQL Server\" & _
"EXCEL AND ACCESS AND SQL SERVER\Excel & Access\Select, Insert, Update & Delete\Northwind.mdb"
Set conn = New ADODB.Connection
conn.Open strConn
With Worksheets("Sheet1")
lastrow = .Range("A2").End(xlDown).Row
lastcolumn = .Range("A2").End(xlToRight).Column
Set rng = .Range(.Cells(lastrow, 1), .Cells(lastrow, lastcolumn))
End With
'therow = 1
For i = 2 To lastrow
'r = rng.Row
'If r > 1 Then
strSQL = "UPDATE PersonInformation SET " & _
"FName='" & Worksheets("Sheet1").Range("B" & i).Value & "', " & _
"LName='" & Worksheets("Sheet1").Range("C" & i).Value & "', " & _
"Address='" & Worksheets("Sheet1").Range("D" & i).Value & "', " & _
"Age=" & Worksheets("Sheet1").Range("E" & i).Value & " WHERE " & _
"ID=" & Worksheets("Sheet1").Range("A" & i).Value
conn.Execute strSQL
'End If
'r = r + 1
Next i
conn.Close
Set conn = Nothing
End Sub
Also...
Sub ExportDataToExcel()
Dim conn As ADODB.Connection
Dim myRecordset As ADODB.Recordset
Dim strConn As String
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\Users\Ryan\Desktop\Coding\Integrating Access and Excel and SQL Server\" & _
"Access & Excel & SQL Server\EXCEL AND ACCESS AND SQL SERVER\Excel & Access\Select, Insert, Update & Delete\Northwind.mdb"
Set myRecordset = New ADODB.Recordset
FocusRow = ActiveCell.Row
With myRecordset
.Open "SELECT * FROM PersonInformation WHERE ID=" & Worksheets("Sheet1").Range("A2").Value, _
strConn, adOpenKeyset, adLockOptimistic
' This assumes that ID is a number field. If it is a text field, use
' .Open "SELECT * FROM PersonInformation WHERE ID='" & Worksheets("Sheet1").Range("A2").Value & "'", _
strConn, adOpenKeyset, adLockOptimistic
.Fields("ID").Value = Worksheets("Sheet1").Range("A" & FocusRow).Value
.Fields("FName").Value = Worksheets("Sheet1").Range("B" & FocusRow).Value
.Fields("LName").Value = Worksheets("Sheet1").Range("C" & FocusRow).Value
.Fields("Address").Value = Worksheets("Sheet1").Range("D" & FocusRow).Value
.Fields("Age").Value = Worksheets("Sheet1").Range("E" & FocusRow).Value
.Update
.Close
End With
Set myRecordset = Nothing
Set conn = Nothing
End Sub
Now, if you want to upgrade to a real database, and use SQL Server, you can use the code below.
Sub InsertIntoSqlServer()
'Declare some variables
Dim cnn As adodb.Connection
Dim cmd As adodb.Command
Dim strSQL As String
'Create a new Connection object
Set cnn = New adodb.Connection
'Set the connection string
cnn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Northwind;Data Source=Excel-PC\SQLEXPRESS"
'cnn.ConnectionString = "DRIVER=SQL Server;SERVER=Your_Server_Name;DATABASE=Your_Database_Name;Trusted_Connection=Yes"
'Create a new Command object
Set cmd = New adodb.Command
'Open the Connection to the database
cnn.Open
'Associate the command with the connection
cmd.ActiveConnection = cnn
'Tell the Command we are giving it a bit of SQL to run, not a stored procedure
cmd.CommandType = adCmdText
'Create the SQL
strSQL = "UPDATE TBL SET JOIN_DT = '2013-01-22' WHERE EMPID = 2"
'Pass the SQL to the Command object
cmd.CommandText = strSQL
'Execute the bit of SQL to update the database
cmd.Execute
'Close the connection again
cnn.Close
'Remove the objects
Set cmd = Nothing
Set cnn = Nothing
End Sub
I retrieve data from SQL Server and store it on a sheet in Excel and then I run an ADO UPDATE query within Excel to update data on a different sheet.
I have not come across this error during developing yet users are reporting they see this error frequently:
Note that the file is located on a network drive, but even after copying the file to a different location, it is still producing said error.
Code:
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim cnn As New ADODB.Connection
Application.ScreenUpdating = False
Application.EnableEvents = False
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & ThisWorkbook.FullName & "';" & _
"Extended Properties=""Excel 12.0;HDR=YES;"";"
Set rs = GetOverview
shUpdateSLSheet.UsedRange.clear
WriteHeadersToSheet rs, shUpdateSLSheet.Name, 1
shUpdateSLSheet.Range("A2").CopyFromRecordset rs
If (rs.EOF And rs.BOF) Then GoTo NoData
cmd.ActiveConnection = cnn
cmd.CommandType = adCmdText
cmd.CommandText = "UPDATE [SL$] INNER JOIN [UpdateSLSheet$] " & _
"ON ([SL$].ID = [UpdateSLSheet$].ID) " & _
"SET [SL$].[CS_A] = [UpdateSLSheet$].[CS_A]" & _
", [SL$].[CS_B] = [UpdateSLSheet$].[CS_B]" & _
", [SL$].[CS_C] = [UpdateSLSheet$].[CS_C]" & _
", [SL$].[CS_D] = [UpdateSLSheet$].[CS_D]" & _
", [SL$].[CS_E] = [UpdateSLSheet$].[CS_E]" & _
", [SL$].[CS_F] = [UpdateSLSheet$].[CS_F]" & _
", [SL$].[Solved By SR] = [UpdateSLSheet$].[SolvedBySR]" & _
", [SL$].[Comments] = [UpdateSLSheet$].[Comments]"
cmd.Execute
Application.EnableEvents = True
Application.ScreenUpdating = True
Set cmd = Nothing
Set rs = Nothing
Set cnn = Nothing
As soon as cmd.Execute gets executed the error comes up.
EDIT: I have no clue why this is happening. I'm going for an iterative approach instead of using ADO in this case.
you have to use the open method for the record set and use the lock type
so the data base actual locked when some one is adding and when this person finish adding the data base will save changes and then another person can start adding
A bit late, but I had the same issue and found a solution: I tried using the OLD driver in the connection string, and it worked like a charm, even if the workbook is an XLSM !
Hope it helps someone.
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & wbName
sConn2 = ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
On Error GoTo hell
Set con = New ADODB.Connection
'con.Open sConn & sConn2
con.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
"DriverId=790;" & _
"Dbq=" & wbName & ";" & _
"DefaultDir=" & wbname & ";ReadOnly=False;"
I am working on an Excel application which allows users to enter hours work through userforms and info is stored in a Access DB. I am new to excel and access connections. I am able to connect to the database but record is not saved/created due to a run-time error at the .Update command.
Run-Time Error '-2147467259 (80004005)': Operation must use an updatable query.
I have searched and searched and can't find a solution to this problem. I hope someone is able to help. (code below)
Sub Export_Data_Access_TI1()
Dim dbPath As String
Dim x As Long, i As Long
Dim nextrow As Long
Dim user As String
Dim NewSht As Worksheet
Dim strQuery As String
Dim recDate As String
Dim Week_Of As String
user = Sheet1.Range("A1").Text
On Error GoTo ErrHandler:
'Variables for file path and last row of data
dbPath = "H:\PROJECTS\CAI_DOT-Time Tracker\CAI_EMP_SignIn_Database.accdb"
nextrow = Cells(Rows.Count, 1).End(xlUp).Row
'Initialise the collection class variable
Set cnn = New ADODB.Connection
'Check for data
If Sheets(user).Range("A2").Value = "" Then
MsgBox " There is no data to send to MS Access"
Exit Sub
End If
cnn.Mode = adModeReadWrite
'cnn.Mode = adModeShareDenyNone
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
Set rst = New ADODB.Recordset 'assign memory to the recordset
rst.CursorLocation = adUseClient
rst.Open Source:="DATA", ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, LockType:=adLockPessimistic, _
Options:=adCmdTable
'rst.Supports (adAddNew)
x = 2 'the start row in the worksheet
Do While Len(Sheets(user).Range("A" & x).Formula) > 0
With rst
.AddNew 'create a new record
.Fields("Date") = ActiveWorkbook.Sheets(user).Range("A" & x).Value
.Fields("Week_Of") = Sheets(user).Range("B" & x).Value
.Fields("Month") = Sheets(user).Range("C" & x).Value
.Fields("Name") = Sheets(user).Range("D" & x).Value
.Fields("Time_In") = Sheets(user).Range("E" & x).Value
.Fields("Time_Out") = Sheets(user).Range("F" & x).Value
.Fields("Time_In2") = Sheets(user).Range("G" & x).Value
.Fields("Time_Out2") = Sheets(user).Range("H" & x).Value
.Fields("Group") = Sheets(user).Range("I" & x).Value
.Fields("UniqueID") = Sheets(user).Range("J" & x).Value
.Fields("Comments") = Sheets(user).Range("K" & x).Value
.Update 'stores the new record
End With
x = x + 1 'next row
Loop
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
'communicate with the user
MsgBox " The data has been successfully sent to the access database"
'Update the sheet
Application.ScreenUpdating = True
'Clear the data
'Sheets(user).Range("A1:K1000").ClearContents
On Error GoTo 0
Exit Sub
ErrHandler:
'clear memory
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
End Sub
As I understand, DATA is a query in the remote accdb. If so, it should be updateable. See, for example this: Why is my query not updateable? for criterias. If this is a table, check if you have read-write rights on accdb and the file has no read-only attribute.
I have queried a excel using ADODB and have a set of data which should be copied to the second worksheet, but when ever i try to insert data it always sits on the 2nd row ignoring the 1st one. I think this is because the 1st row is always treated as header. Are there any ways to insert data into the excel by creating 1st row as header and subsequently with values(with respect to the code i have written below).
Exceldb = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\VAS_AUTOMATION_v1.1\Book1.xlsx;Extended Properties=""Excel 12.0;HDR=Yes;"";"
Dim sDBConnectionString, i, iCol
Set con = CreateObject("ADODB.Connection")
sDBConnectionString = Exceldb
con.ConnectionString = sDBConnectionString
con.Open
If Err.Number <> 0 Then
For i = 1 to 4
Err.Clear
wait 5
con.Open
If Err.Number = 0 Then
msgbox "opened"
End If
Next
else
msgbox "opened"
End If
strROW = "UNIXOPERATIONS_16"
strROWID = "'" & strROW & "'"
strQuery = "INSERT INTO [Sheet3$A1:A1] (" & strROWID1 & ") Values(" & strROWID & ")"
Set strRecordSet = CreateObject("ADODB.Recordset")
Dim objCmd 'As New ADODB.Command
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = con
objCmd.CommandType = 1
objCmd.CommandText = strQuery
Set strRecordSet = objCmd.Execute
con.Close
I have Googled without much luck. Basically each creation of a excel spreadsheet (based on a template), needs to be password protected. Can this be done?
'______________________CreateExcel()____________________________________
Function CreateExcel()
SELECT DATA FROM SQL TABLE
If objStructure.BOF = False And objStructure.EOF = False Then
Do While objStructure.EOF = False
Call CreateActualExcel()
objRsExcel.Fields("Field") = objStructure.Fields("Field")
objStructure.MoveNext
Loop
End If
End Function
'......................End CreateExcel()..................................
'______________________CreateActualExcel()________________________________
Sub CreateActualExcel()
Dim objSFSO
Dim strCon, strSQL
strFile = " Staffing_List_" & Clng(Timer()) & ".xls"
Set objSFSO = CreateObject("Scripting.FileSystemObject")
objSFSO.CopyFile conFolder & conTemplate, conFolder & strFile
Set objSFSO = Nothing
Set objRsExcel = CreateObject("ADODB.RecordSet")
strCon = _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
conFolder & strFile & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;maxscanrows=1;"";"
strSQL = "Select * From [Sheet1$]"
objRsExcel.Open strSql, strCon, 3, 2
End Sub
'......................End CreateActualExcel()............................
Thanks in advance for any help.
Clare :-)
I think you can pass the password as an additional parameter when you save the file.
excelObj.SaveAs "C:\Example.xls",,"your-password"
I haven't tested this but I found this blog post about it:
http://qtp.blogspot.co.uk/2010/04/vbscript-excel-password-protect.html