VBA SQL Query w/WHERE Clause Condition = GetUserName() From MS ACCESS DB

bemp87

Board Regular
Joined
Dec 10, 2016
Messages
102
Hi Community,

Hoping you can assist with helping me understand what i'm doing wrong with code I found from another post for querying an Microsoft Access Database to retrieve records WHERE a Column value = GetUserName().

When i run the code I either get an error, OR i don't get an error and it pulls the column name instead of the actual rows / records... Not sure what i'm doing wrong..

Using this specifc codie i get the following error message:
"Undefined function 'GetUserName' in expression. Error at line :0, Error Number :-2147217900"

Code:
Public Sub ShiftSwap_DBOpen()          Dim cn As Object, rs As Object, rs1 As Object
          Dim intColIndex As Integer
          Dim DBFullName As String
          Dim TargetRange As Range


          
DBFullName = "C:\Users\MyName\Documents\ShiftSwapDB.mdb"
On Error GoTo Whoa


Application.ScreenUpdating = False


Set TargetRange = Sheets("Sheet2").Range("A5")


Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"




Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT Req_Key, Submitted_Date, Swap_Req_Date, Swap_Req_Shift, Swap_Day_Work, Swap_Req_Time FROM ShiftSwap [COLOR=#FF0000]WHERE Req_Key[/COLOR] = [COLOR=#FF0000]GetUserName()[/COLOR]", cn, , , adCmdText


          ' Write the field names
For intColIndex = 0 To rs.Fields.Count - 1
TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
    Next


          ' Write recordset
TargetRange.Offset(1, 0).CopyFromRecordset rs




LetsContinue:
Application.ScreenUpdating = True
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
On Error GoTo 0
Exit Sub
Whoa:
MsgBox "Error Description :" & Err.Description & vbCrLf & _
             "Error at line     :" & Erl & vbCrLf & _
             "Error Number      :" & Err.Number
Resume LetsContinue
End Sub
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
I guess the user name function is in Excel

right now, the SQL has the function name hard-coded in it. instead the SQL (which is just text) needs to be created (concatenated) - so put the value returned from the user name into the SQL

something like
Code:
'replace this line
rs.Open "SELECT Req_Key, Submitted_Date, Swap_Req_Date, Swap_Req_Shift, Swap_Day_Work, Swap_Req_Time FROM ShiftSwap WHERE Req_Key = GetUserName()", cn, , , adCmdText


'by this line
rs.Open "SELECT Req_Key, Submitted_Date, Swap_Req_Date, Swap_Req_Shift, Swap_Day_Work, Swap_Req_Time FROM ShiftSwap WHERE Req_Key = '" & GetUserName() & "'", cn, , , adCmdText

PS. I assume everything else is OK
 
Last edited:
Upvote 0
That worked pefectly!

Can i ask one other question on this post that is related and part of the same project. I am trying to insert rows into the database but the insert is inserting everyting on the sheet, and will not allow me to seect either a range or starting point rom where I want the row inserts to start, any guidance- the code is posted below:

Code:
Public Sub ShiftSwap()

Set rg = Worksheets("ShiftSwap").Range("A3")


Set cn = CreateObject("ADODB.Connection")
dbPath = Application.ActiveWorkbook.Path & "\ShiftSwapDB.mdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cn.Open scn
ssql = "INSERT INTO ShiftSwap ([Req_Key], [Submitted_Date], [Swap_Req_Date], [Swap_Req_Shift], [Swap_Day_Work], [Swap_Req_Time]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh






cn.Execute ssql




End Sub
 
Upvote 0
it is inserting everything because that what the code says to do. near the end of the code, the line is "SELECT *"

there are many, many options & I don't know what you want - so can't advise without knowing specifics

simplest might be to have a dedicated extra worksheet just as a temporary store for data to be loaded, and load from there.
so add an extra worksheet (can be hidden) and populate it with the specific data you want to load. this may be a subset of the full data on the worksheet starting from whatever row you want, or filtered how you want
 
Upvote 0
Hi Fazza, this is actually a great suggestion- I had not thought to do this, but immediately know how to make this happen. But im just curious, if i wanted to use the current code or any variation thereof to start with inserting rows at for example "A3" how would i be able to start the row insert from a specific part of the sheet instead of just inserting the entire sheet as its currently doing?
 
Upvote 0
again, REALLY specific info is needed (on what you want & the set up you have. based on the description given, what follows is really just rough, general advice. What might work best for you might be something different. there are many options, and maybe nuances depending on if you have headers or not, etc)

you could try just hard coding the address within the SQL. something like "SELECT * FROM [" & YourWorksheet.Name & "$A3:Z99]"
which with some simple VBA can create the actual address for the range you want (to replace the A3:Z99. The $ sign is required syntax with the worksheet name, it is nothing to do with the range address like in a worksheet formula where it fixes column A. That is, it is NOT $A3:Z99. the $ sign goes with the worksheet name. It is [worksheetname$], then address A3:Z99)

normally, though, the data to be loaded would be filtered using SQL criteria. That is, not range address
 
Last edited:
Upvote 0
PS

If you have a bit of data, IIRC a faster & more robust approach is to load the data into an array and load from there instead of from the worksheet.

Of course, by using an array you again have many, many options of how to select what gets loaded.

I'll have a look for an old post on the subject.

Edit: I think this is it [URL]https://www.mrexcel.com/forum/printthread.php?t=698670&pp=10&page=1[/url]
 
Last edited:
Upvote 0
This is great, thank you so much- i'm going to give it a try and see how it works, i have no doubt it will not only solve my problem and perhaps more than what i need which is great!
 
Upvote 0
Hi Community - is there anyway i can use the following code to connect to a MS Access DB stored on sharepoint instead of my local machine or a shared drive? I ran into some issues with permissions, and found that this DB would need to be stored on sharepoint- any guidance?

Code:
Public Sub ShiftSwap_DBOpen() Dim cn As Object, rs As Object, rs1 As Object
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range



DBFullName = "C:\Users\MyName\Documents\ShiftSwapDB.mdb"
On Error GoTo Whoa


Application.ScreenUpdating = False


Set TargetRange = Sheets("Sheet2").Range("A5")


Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"




Set rs = CreateObject("ADODB.Recordset")
rs.Open "SELECT Req_Key, Submitted_Date, Swap_Req_Date, Swap_Req_Shift, Swap_Day_Work, Swap_Req_Time FROM ShiftSwap [COLOR=#FF0000]WHERE Req_Key[/COLOR] = [COLOR=#FF0000]GetUserName()[/COLOR]", cn, , , adCmdText


' Write the field names
For intColIndex = 0 To rs.Fields.Count - 1
TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
Next


' Write recordset
TargetRange.Offset(1, 0).CopyFromRecordset rs




LetsContinue:
Application.ScreenUpdating = True
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
On Error GoTo 0
Exit Sub
Whoa:
MsgBox "Error Description :" & Err.Description & vbCrLf & _
"Error at line :" & Erl & vbCrLf & _
"Error Number :" & Err.Number
Resume LetsContinue
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top