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:
[COLOR=#333333]Public Sub ShiftSwap_DBOpen() Dim cn As Object, rs As Object, rs1 As Object[/COLOR]
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range
[COLOR=#ff0000][B]DBFullName[/B][/COLOR] = "[COLOR=#ff0000]C:\Users\MyName\Documents\ShiftSwapDB.mdb[/COLOR]"
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 WHERE Req_Key = GetUserName()", 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 [COLOR=#333333]End Sub[/COLOR]
Last edited:
