I'm in the process of moving all the Lotus sheets a company has to a SQL Server and I am using MS Access tables as an intermediary.
This code has been working fine for sheets that are not named but I've come across about 2300 or so sheets where it's named numb. There are too many files for me to manually change them all.
The error I am getting is:
Run-Time error '-2147217865(80040e37)':
The Microsoft Jet Database engine could not find the object "numb:A1..numb:A8000". Make sure the object exists and that you spell its name and the path name correctly.
Found this site but that hasn't provided the answer
I've seen different options for getting the destination right on an ADOB call ("SELECT * FROM [numb:A1..numb:A8000];" or ("SELECT * FROM [numb$:A1..numb$:A8000];") and those haven't worked.
Here is the functioning code when the sheet isn't named:
Dim rst As DAO.Recordset
Dim rs As DAO.Recordset
Dim LotusCn As Object
Dim rsLotus As Object
'Read WK3 Lotus files
repcode = rs![Code]
Directory = rs![Directory]
Directory = Directory & "NUMDATM.WK3"
Set LotusCn = CreateObject("ADODB.Connection")
Set rsLotus = CreateObject("ADODB.Recordset")
'This creates the objects for the lotus connctions
'below the connection string
LotusCn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Directory & ";" & _
"Extended Properties=Lotus WK3;Persist Security Info=False"
strSQL = "SELECT * FROM [A1..A8000];" 'The SQL to pick the right sections of the lotus file. Picks the Latest Available Date
rsLotus.Open strSQL, LotusCn, adOpenStatic '<<< ***Error occurs here***
If Not (rsLotus.EOF And rsLotus.BOF) Then
FindRecordCount = rsLotus.RecordCount
rsLotus.MoveFirst
Do Until rsLotus.EOF = True
Debug.Print rsLotus.Fields(0).Value
If Len(rsLotus.Fields(0).Value) > 0 Then
rst.AddNew
rst!RegNo = rsLotus.Fields(0).Value
rst.Update
End If
rsLotus.MoveNext
Loop
End If
LotusCn.Close
strSQL = ""
Set rsLotus = Nothing
Set LotusCn = Nothing
Does anyone know how to get named spreadsheets?
I dont know exactly how in Lotus but this was in Excel
Set oRs = oConn.OpenSchema(adSchemaTables) 'get the name of the sheet in Excel
oRs.MoveFirst
With oRs
While Not .EOF
If .fields("TABLE_TYPE") = "TABLE" Then
Debug.Print .fields("TABLE_NAME")
If VBA.Len(.fields("TABLE_NAME")) = 9 Then
WSnameTBL = .fields("TABLE_NAME")
Else
End If
' WSnameTBL = VBA.Replace(WSnameTBL, "$", "", 1, , vbTextCompare)
End If
.MoveNext
Wend
End With
Related
I'm developping modules on a client XLSm with 32-bits 2013 Excel.
I'd like to use datas on worksheet as if it is an Access table.
With a lot of difficulties, I think connection is now OK.
Still, I have error : 3001 Arguments are of wrong type, are out of acceptable range. Error that I cannot understand.
Here excerpts of VBA lines :
In addition, I added 20 lines in data Worksheet below the header line to permit to Excel to interpret for the type of each columns.
varCnxStr = "Data Source=" & G_sWBookREINVOICingFilePath & ";" & "Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=15';"
With conXLdb
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Mode = adModeShareExclusive
.Open varCnxStr
End With
strSQL = "SELECT * "
strSQL = strSQL & " FROM [ReInvoiceDB$B2B5072] inum "
strSQL = strSQL & " WHERE inum.InvoiceNum LIKE '1712*' "
strSQL = strSQL & ";"
'>> TRIGGERs ERROR with the current Where Clause !!'
adoXLrst.Open strSQL, conXLdb, dbOpenDynamic, adLockReadOnly, adCmdText
If adoXLrst.BOF And adoXLrst.EOF Then
'no records returned'
GoTo Veloma
End If
adoXLrst.MoveFirst
Do While Not adoXLrst.EOF
'Doing stuff with row'
adoXLrst.MoveNext
Loop
sHighestSoFar = adoXLrst(1).Value '> just to try for RecordSet : Codes are not completed...
sPrefixeCURR = Mid(sHighestSoFar, 1, 4)
Highest = CInt(Mid(sHighestSoFar, 5))
'> Increment >'
Highest = Highest + 1
HighestStr = sPrefixeCURR & Format(Highest, "00")
strGSFNumber = HighestStr
adoXLrst.Close
conXLdb.Close
Veloma:
On Error Resume Next
Set adoXLrst = Nothing
Set conXLdb = Nothing
Exit Sub
Etc.
Any idea about what seems be wrong ?
Thank you
Below is an old example I have been using successfully. Note that the sheet name in the book are Sheet1 and Sheet2, but in the query I had to use sheet1$ and sheet2$. I noticed you had $ signs in the middle of your sheet names. perhaps that's the issue ?
Sub SQLUpdateExample()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
con.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
"DriverId=790;" & _
"Dbq=" & ThisWorkbook.FullName & ";" & _
"DefaultDir=" & ThisWorkbook.FullName & ";ReadOnly=False;"
Set rs = New ADODB.Recordset
Set rs = con.Execute("UPDATE [Sheet1$] inner join [Sheet2$] on [Sheet1$].test1 = [Sheet2$].test1 SET [Sheet1$].test3 = [Sheet2$].test2 ")
Set rs = Nothing
Set con = Nothing
End Sub
To give more details about the whole module to be implemented : it is to perform a Transaction unit.
This transaction will comprise 3 operations : get a max value from a column (Invoice number) to increment it, record the new number inside an Access table (by DAO), the same Excel file (by ADO) and generating document on HDD.
So it is aimed to use the Excel file as a table not as a file manipulated with Windows script or Excel VBA. My end user is disturbed by the pop-uping of an Excel opening file operation. As a developer, I'm feeling more comfortable with using SQL statements as much as possible inside Transaction session. Is that your opinion too ?
Using Excel 2010, SQL and DAO
I am trying to execute a query against tables which reside outside the current spreadsheet. This would be trivial, inside Access, with linked tables/databases, but using VBA in excel, I am stymied.
Presuming these:
ExcelFileOne; Tab; various headed field/columns
ExcelFileTwo; Tab; various headed field/columns
I want to execute a query inside a third excel file, that goes something like this [using dot notation for explanation, not coding....] -- a simple example:
SELECT FileOne.[Tab$].Fields, FileTwo.[Tab$].Fields, etc.
FROM FileOne, FileTwo, Thisworkbook
WHERE (FileOne.[Tab$].field2 <> FileTwo.[Tab$].Field2)
AND (ThisWorkbook.[Tab$].Field1 ....)
Basically, I want to duplicate what Access will do natively, for that linked file.
Pointers in the right directions ?
[[ I could use a pointer towards why using "Excel 8.0..." in a connection works or fails on Excel2010, with macro files, and how to load the 12 or 14 variant in a network/system closed to users.... ]]
You can indeed query other workbooks using DAO and ADO directly in a SQL statement and likewise query Access databases tables by simply referencing their paths. Conversely, within an Access query you can query Excel workbooks! This is testament to the fact that Jet/ACE SQL engine (Windows .dll files) is not restricted to any one MS Office product or Windows program but a tool for all.
In both examples below, macros make a direct connection to first workbook and in SQL query each indirectly connects to second workbook. You can run code inside or outside either workbooks. Also both runs genric INNER JOIN on FileOne and FileTwo worksheets but any compliant Jet/ACE SQL statement should work. And both output query results in a pre-existing RESULTS tab.
DAO
Dim dbE As Object, db As Object, rst As Object
Dim sqlString As String
Dim i As Integer
Const dbOpenDynaset = 2, dbReadOnly = 4
' OPEN DB CONNECTION
Set dbE = CreateObject("DAO.DBEngine.120") 'ALSO TRY: DAO.DBEngine.35 OR .36
Set db = dbE.OpenDatabase("C:\Path\To\FileOne.xlsm", False, True, "Excel 12.0 Xml;HDR=Yes")
' OPEN QUERY RECORDSET
sqlString = " SELECT * FROM [TAB$] t1" _
& " INNER JOIN (SELECT * FROM" _
& " [Excel 12.0 Xml;HDR=Yes;Database=C:\Path\To\FileTwo.xlsm].[TAB$]) t2" _
& " ON t1.ID = t2.ID"
Set rst = db.OpenRecordset(sqlString, dbOpenDynaset, dbReadOnly)
' COLUMNS
For i = 1 To rst.Fields.Count
Worksheets("RESULTS").Cells(1, i) = rst.Fields(i - 1).Name
Next i
' DATA ROWS
Worksheets("RESULTS").Range("A2").CopyFromRecordset rst
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing
Set dbE = Nothing
ADO
Dim conn As Object, rst As Object, fld As Object
Dim strConnection As String, strSQL As String
Dim i As Integer
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
' OPEN DB CONNECTION
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C:\Path\To\FileOne.xlsm';" _
& "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
conn.Open strConnection
' OPEN QUERY RECORDSET
strSQL = " SELECT * FROM [TAB$] t1" _
& " INNER JOIN (SELECT * FROM" _
& " [Excel 12.0 Xml;HDR=Yes;Database=C:\Path\To\FileTwo.xlsm].[TAB$]) t2" _
& " ON t1.ID = t2.ID"
rst.Open strSQL, conn
' COLUMNS
For i = 1 To rst.Fields.Count
Worksheets("RESULTS").Cells(1, i) = rst.Fields(i - 1).Name
Next i
' DATA ROWS
Worksheets("RESULTS").Range("A2").CopyFromRecordset rst
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
I am super new at this and need help. I am trying to send a query as an excel document to specific people contained in a table called "tblRelationship", the email is in a field called "Email". However, there are more people in this table then I want to send to. There is a third field called "RelationshipType" that I need to set to = Accounting
I have been using this code that I found:
Const stDocName As String = "qryPOAccountingReport"
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim stRecipients As String
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblRelationship")
With rs
Do While Not .EOF
stRecipients = stRecipients & ";" & !Email
.MoveNext
Loop
.Close
End With
If Len(stRecipients) > 0 Then
' discard leading ";"
stRecipients = Mid(stRecipients, 2)
DoCmd.SendObject acQuery, stDocName, acFormatXLS, _
stRecipients, , , "Thank You for your purchase"
Else
MsgBox "No recipients to email!"
End If
Set rs = Nothing
Set db = Nothing
And it works great. I just don't understand how to put the "RelationshipType" criteria in there. Can anyone help?
Thank you in advance!
Simply, run a query in your OpenRecrdset() which can take whole tables, stored queries, or SQL Select statements:
Set rs = db.OpenRecordset("SELECT [Email] FROM tblRelationship" _
& " WHERE RelationshipType='Accounting'")
I am trying to use the ADO to read in a series of text files into a worksheet. I am running into problems when the majority of the data in a specific column are integers. It will give null values (blank cells) when it reaches a String.
According to microsoft support (Ado mixed data tyes) this is a common thing and the solution is to set the IMEX = 1. I tried this however it didn't work.
I have been searching others threads looking for the answer and came across this answer (other thread) where the author says to change TypeGuessRows to "get the Jet to detect whether a mixed types situation exists and trick the Jet into detecting a certain data type." However, this hasn't worked either.
Below is my VBA code. Any help would be appreciated
Sub query_text_file(WorkingSheet As String, Col As String, Row As Integer, fileName As String, firstOrLast As Integer)
Dim strPath As String
Dim ws As Worksheet
strToolWkbk = fileName
strPath = ThisWorkbook.Path & "\Excel_Barcode_Files"
Set ws = Worksheets(WorkingSheet)
'Need to reference the:
' Microsoft ActiveX Data Objects 2.5 Library
Dim s_rst As ADODB.Recordset
Dim s_cnn As ADODB.Connection 's for sub connection
Dim intRow As Integer
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Set s_cnn = New ADODB.Connection
s_cnn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath & ";" _
& "Extended Properties=""text;HDR=Yes;IMEX=1;TypeGuessRows=12;FMT=Delimited"";"
s_cnn.Open
Set s_rst = New ADODB.Recordset
strSQL = "SELECT * FROM " & strToolWkbk
s_rst.Open strSQL, _
s_cnn, adOpenStatic, adLockOptimistic, adCmdText
intRow = Row
s_rst.MoveFirst
Do Until s_rst.EOF
ws.Range(Col & intRow) = s_rst(0)
ws.Range(Chr(Asc(Col) + 1) & intRow) = s_rst(1)
intRow = intRow + 1
s_rst.MoveNext
Loop
s_rst.Close
s_cnn.Close
Set s_rst = Nothing
Set s_cnn = Nothing
End Sub
Here is a sample text file. The code reads in everything except the "P"
test test
P,0
1,1
5,2
6,3
Basically, don't rely on the registry entries as explained here on MSDN.
You need to create a Schema.ini file and put it in the same folder as all your text files. In the Schema.ini you specify the type for all columns you may have in your text files - it's just a much safer option to do that explicitly rather than have the driver work out the correct types for columns...
Say you have some txt files on your desktop, open Notepad and copy paste the below - make sure you adjust the [test.txt] part to match the name of your actual txt file and save it as: Schema.ini
[test.txt]
Format=CSVDelimited
Col1=Column1 Text
Col2=Column2 Text
Make sure you add another slash at the end of the parth in the strPath (also indicated in the article)
strPath = ThisWorkbook.Path & "\Excel_Barcode_Files\"
*Keep in mind that I am working in a different location to yours - I am using my Desktop for this example and my text file is named test.txt
Now, that you have a Schema.ini you can modify the connection string and take out some parameters which are not required because they exists in the Schema.ini
So bascially an SSCCE based on the above assumptions would be:
Sub Main()
Cells.ClearContents
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim thePath As String
thePath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & thePath & ";" _
& "Extended Properties=""text;HDR=No;"""
cn.Open
Dim sql As String
sql = "SELECT * FROM test.txt"
' populate the recordset
rs.Open sql, cn, adOpenStatic, adLockOptimistic, &H1
' copy the recordset starting at Range("A1") - assuming there are no headers - see HDR = No;
Range("A1").CopyFromRecordset rs
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Now after running this you should see all the values including the missing P:
I am seeking one suggestion on how to build an excel macro for below requirement. Request you to provide your valuable comments in EXCEL Only.
Scenario
I have one spreadsheet "Product Master" that contains all the product details.
(i.e. Product ID,Product Name,Product Type,Quantity etc etc)
I am designing a UserForm using excel VBA where anyone can fetch all the details of a product based on its Product ID. Now the product-master sheet where all the product details is present will get updated on a daily basis. And each user should be able to update any details in that sheet based on his requirement.
Questions/Doubts
How do I design my system? I mean where should I put my "Product-Master" spreadsheet so that it can be accessed by multiple users. What I am thinking is to put product-masster on a shared_drive so that all can access that sheet through VBA userform. I will provide excel VBA userform macro to everyone in my office & they will query that sheet present in shared drive. does this seem ok?
Does excel provide facility to Query data from sheet present in shared-drive & update it when required. And I want this to be queried by multiple users at a time.
I know there are other products/technologies that provides better solution than EXCEL. But I want the solution in EXCEL ONLY.
I would appreciate it if anyone can provide his/her valuable comments on this. Let me know in case you need any details.
Thanks you.
Here are some example functions getting data from/posting data to MS Access (took me awhile to dig these up, hah!). This uses a Reference to the Microsoft DAO 3.6 Object Library and will only work with legacy .mdb files, not accdb (because the mdb driver is 100x faster and doesn't have a memory leak.)
Const DBPath As String = "Full\Database\Path"
Function GET_ACCESS_DATA(DBPath, SQL) As Object
Dim dbConn As Object
Dim dbRS As Object
Dim SQL As String
On Error GoTo ErrorHandler
SQL = "Sql Query"
'Set up database connection string
Application.StatusBar = "Connecting to Database..."
'Open database connection
Set dbConn = OpenDatabase(DBPath)
'Run the query
Application.StatusBar = "Running Query..."
Set dbRS = dbConn.OpenRecordset(SQL, DAO.dbOpenForwardOnly, DAO.RecordsetOptionEnum.dbReadOnly)
'If no rows returned, display error message and exit
If dbRS.RecordCount = 0 Then
Application.StatusBar = "Running Query...Error"
MsgBox "There are no records for the selected criteria.", vbInformation, "Refresh Data"
Application.StatusBar = "REFRESHING DATA PLEASE WAIT.."
Exit Function
End If
'returns DAO Recordset with the data
Set GET_ACCESS_DATA = dbRS
'A recordset can either be looped through or pasted to a spreadsheet with the Worksheet.Range.CopyFromRecordset method
'Error trap here
End Function
Function POST_TO_ACCESS() As Boolean
POST_TO_ACCESS = False
errormod = "TRACKING"
On Error GoTo ERROR_TRAP:
'START CONTROLS
Application.StatusBar = "Formatting Data"
St_Timer = Timer 'start connection timer
Dim cn As DAO.Database
Set cn = DAO.OpenDatabase(DBPath)
En_Timer = Timer 'get connection time
'SetKey Parameters
UserNM = Replace(User_Name(), Chr(39), "")
CompNm = Environ("COMPUTERNAME")
Elapsed_Time = En_Timer - St_Timer
SQL = "INSERT INTO TBL_TRACKING " & _
"(UserNM) " & _
" VALUES ('" & UserNM & "')"
cn.Execute SQL
cn.Close
'END CONTROLS
Application.StatusBar = False
POST_TO_ACCESS = True
'error trap here
End Function
Function User_Name()
'This just gets the LDAP username of whoever is logged in. Useful for tracking. Not guarenteed to work for your Active Directory :)
Dim WshNetwork
Dim objAdoCon, objAdoCmd, objAdoRS
Dim objUser, objRootDSE
Dim strDomainDN, strUserName, strUserFullName
strUserFullName = ""
Set WshNetwork = CreateObject("WScript.Network")
strUserName = WshNetwork.UserName
Set objRootDSE = GetObject("LDAP://rootDSE")
strDomainDN = objRootDSE.Get("defaultNamingContext")
Set objAdoCon = CreateObject("ADODB.Connection")
objAdoCon.Open "Provider=ADsDSOObject;"
Set objAdoCmd = CreateObject("ADODB.Command")
Set objAdoCmd.ActiveConnection = objAdoCon
objAdoCmd.CommandText = _
"SELECT ADsPath FROM 'LDAP://" & strDomainDN & "' WHERE " & _
"objectCategory='person' AND objectClass='user' AND " & _
"sAMAccountName='" & strUserName & "'"
Set objAdoRS = objAdoCmd.Execute
If (Not objAdoRS.EOF) Then
Set objUser = GetObject(objAdoRS.Fields("ADsPath").Value)
objUser.GetInfoEx Array("displayName"), 0
strUserFullName = objUser.Get("displayName")
Set objUser = Nothing
User_Name = strUserFullName
Else
End If
Set objAdoRS = Nothing
Set objAdoCmd = Nothing
objAdoCon.Close
Set objAdoCon = Nothing
Set objRootDSE = Nothing
Set WshNetwork = Nothing
End Function