I'm working on ADO record set with a connection string using the same code from a 2006 database.
The goal is to select from a record set (by the field "pick" yes/no) then open a excel object and populate
the cells from the record set.
When I bring up the 2006 database, it works, excel is populated.
But using the same code in the new 2016 access database it bombs at the teh "Cnx.open"
with msg "unreconized database format"
I checked the reference in both to make sure there the same.
I haven't done any code since 2009 so I'm not up to date with changes or updates.
Thanks and can anyone help me get the code right.
Here is the unfinished new code. and below is the original 2006 code
-----------------------------------------------------
Private Sub cmdExcellRpt_Click() 'xl report
Dim xlAdd As Integer
Dim xlApp As Excel.Application 'reference excel application object
Dim xlDoc As Excel.Worksheet 'reference excel worksheet object. Worksheet object is b
Me.Requery
Me.Refresh
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Set Cnx = New ADODB.Connection 'set cnx to a new adodb connection
Set Rst = New ADODB.Recordset 'set rst to a new adodb recordset
Set fso = CreateObject("Scripting.FileSystemObject") ''filesystemobject allows you to do almost any kind of file operation...such as renaming, getting extensions or filepaths, etc
Cnx.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Access.CurrentDb.Name & ";Persist Security Info=False"
Cnx.Open 'bomb here
If Rst.State = 1 Then Rst.Close
Rst.Open "select * from MASTERDWG_TBL where ([Pick] = -1 and " & Right(Me.Filter, Len(Me.Filter) - 1), Cnx, adOpenKeyset, adLockOptimistic
Rst.Close
Cnx.Close
-----------------------------------------------Here is the original 2006 code that works
Private Sub cmdReport_Click() 'xl report
On Error GoTo CmdRepErr
Dim xlAdd As Integer
Dim xlApp As Excel.Application 'reference excel application object
Dim xlDoc As Excel.Worksheet 'reference excel worksheet object. Worksheet object is basically a document object
Dim FileStr As String 'string for the filename i will rename the xls file to
Dim wrkOrder As String
Dim projNum As String
Dim transNum As String
Dim transDat As String
Dim pgNum As Integer
Me.Requery
Me.Refresh
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Set Cnx = New ADODB.Connection 'set cnx to a new adodb connection
Set Rst = New ADODB.Recordset 'set rst to a new adodb recordset
Set fso = CreateObject("Scripting.FileSystemObject") 'set fso to the filesystemobject
'filesystemobject allows you to do almost any kind of file operation...such as renaming, getting extensions or filepaths, etc
Cnx.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Access.CurrentDb.Name & ";Persist Security Info=False"
Cnx.Open 'set the connectionstring and open the connection
If Rst.State = 1 Then Rst.Close 'if the recordset is open then close it
Rst.Open "select * from DrawingIndex_tbl where ([Pick] = -1 and " & Right(Me.Filter, Len(Me.Filter) - 1), Cnx, adOpenKeyset, adLockOptimistic
Set xlApp = New Excel.Application 'set the application object to a new excel session
xlApp.Workbooks.Open fso.getparentfoldername(Access.CurrentDb.Name) & "\Drawing Index template.xls" 'open the template xls file
xlApp.Visible = True 'bring it up on screen
Set xlDoc = xlApp.ActiveSheet 'set the document object to the template xls we just opened
xlDoc.PageSetup.CenterHorizontally = True
xlDoc.PageSetup.CenterVertically = True
pgNum = 1
If Rst.RecordCount > 0 Then
xlDoc.Range("M3").Value = 1
For xlAdd = 1 To Rst.RecordCount
If Right(CStr(xlAdd), 1) = "1" And xlAdd > 10 Then
xlDoc.Range("A1:P47").Copy xlDoc.Range("A" & CStr((47 * (CInt(xlAdd / 10))) + 1))
xlDoc.Range("M" & CStr((47 * (CInt(xlAdd / 10))) + 3)).Value = CInt(xlAdd / 10) + 1
pgNum = CInt(xlAdd / 10) + 1
xlDoc.PageSetup.PrintArea = "A1:P" & CStr((47 * (CInt(xlAdd / 10))) + 47)
xlDoc.Rows((47 * (CInt(xlAdd / 10)) + 1)).PageBreak = xlPageBreakManual
End If
Next xlAdd
xlDoc.Range("O3").Value = pgNum
For xlAdd = 0 To pgNum - 1
xlDoc.Range("O" & CStr((47 * xlAdd) + 3)).Value = pgNum
Next xlAdd
End If
xlAdd = 7
Do Until Rst.EOF 'for each record we just opened with the recordset
If Right(CStr(Rst.AbsolutePosition), 1) = "1" And Rst.AbsolutePosition > 10 Then xlAdd = xlAdd + 7
xlDoc.Range("A" & CStr(xlAdd + Rst.AbsolutePosition)).Value = Rst.Fields("Unit Number")
xlDoc.Range("B" & CStr(xlAdd + Rst.AbsolutePosition)).Value = Rst.Fields("Discipline Number")
xlDoc.Range("C" & CStr(xlAdd + Rst.AbsolutePosition)).Value = Trim(Rst.Fields("Sequence Number"))
xlDoc.Range("D" & CStr(xlAdd + Rst.AbsolutePosition)).Value = Trim(Rst.Fields("Project Number"))
xlDoc.Range("E" & CStr(xlAdd + Rst.AbsolutePosition)).Value = Rst.Fields("Drafting Number")
xlDoc.Range("L" & CStr(xlAdd + Rst.AbsolutePosition)).Value = Trim(Rst.Fields("Company"))
xlDoc.Range("L" & CStr(xlAdd + Rst.AbsolutePosition + 2)).Value = Trim(Rst.Fields("Draftsmen"))
If IsNull(Rst.Fields("Original Date")) = False Then xlDoc.Range("O" & CStr(xlAdd + Rst.AbsolutePosition)).Value = CStr(Rst.Fields("Original Date"))
xlAdd = xlAdd + 3
Rst.MoveNext 'move to the next record AND increment the absoluteposition value by 1
Loop
Rst.Close 'close recordset object
Cnx.Close 'close connection object
FileStr = fso.getparentfoldername(Access.CurrentDb.Name) & "\DWGIndex" & Format(Date, "mmddyy") & "_" & Format(Time, "hhmmss")
'JRB * xlDoc.SaveAs FileStr 'saveas the string we just made by concatenating the database path with the current date and time; formatted as numbers.
Exit Sub
CmdRepErr:
MsgBox Err.Description
Resume
End Sub