Excel

  ' Declare for call to mpr.dll.
   Declare Function WNetGetUser Lib "mpr.dll" _
      Alias "WNetGetUserA" (ByVal lpName As String, _
      ByVal lpUserName As String, lpnLength As Long) As Long

   Const NoError = 0       'The Function call was successful

   Sub GetUserName()

      ' Buffer size for the return string.
      Const lpnLength As Integer = 255

      ' Get return buffer space.
      Dim status As Integer

      ' For getting user information.
      Dim lpName, lpUserName As String

      ' Assign the buffer size constant to lpUserName.
      lpUserName = Space$(lpnLength + 1)

      ' Get the log-on name of the person using product.
      status = WNetGetUser(lpName, lpUserName, lpnLength)

      ' See whether error occurred.
      If status = NoError Then
         ' This line removes the null character. Strings in C are null-
         ' terminated. Strings in Visual Basic are not null-terminated.
         ' The null character must be removed from the C strings to be used
         ' cleanly in Visual Basic.
         lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
      Else

         ' An error occurred.
         MsgBox "Unable to get the name."
         End
      End If

      ' Display the name of the person logged on to the machine.
      MsgBox "The person logged on this machine is: " & lpUserName

   End Sub

Private Declare Function GetComputerName Lib "kernel32" _
    Alias "GetComputerNameA" _
    (ByVal lpBuffer As String, nSize As Long) As Long


Function ReturnComputerName() As String
Dim rString As String * 255, sLen As Long, tString As String
    tString = ""
    On Error Resume Next
    sLen = GetComputerName(rString, 255)
    sLen = InStr(1, rString, Chr(0))
    If sLen > 0 Then
        tString = Left(rString, sLen - 1)
    Else
        tString = rString
    End If
    On Error GoTo 0
    ReturnComputerName = UCase(Trim(tString))
End Function

Here is an example of using the DB Code

' Load Duration sheet
Sub Load_Duration()
    Dim sqlQry As String
    Dim ds As String
    Dim dbConn As ADODB.Connection
    
    ds = Format(Worksheets("Main").Range("Risk_Date"), "YYYYMMDD")
    sqlQry = "select isin, duration, date from durations where date = '" & ds & "'"
    WSDuration.Range("Duration").ClearContents
    
    Set dbConn = Db.OpenConnection_ODBC(GetDBParams("FASER", "_SERVER"), _
                                        GetDBParams("FASER", "_DB"), _
                                        GetDBParams("FASER", "_USER"), _
                                        GetDBParams("FASER", "_PASSWORD"))
    Call SQLToRangeName(dbConn, sqlQry, WSDuration, "Duration", True)
    
    If WSDuration.Range("Duration").Rows.count < 2 Then 
        AddLogItem ("Load_Duration : Warning - no data retrieved for Duration")
    End If
End Sub

Pretty easy. The parameters are straight forward extracts from a sheet or a parameter file.

Setting up the sql query is easy.

Results go to one sheet.

To further use the results, vlookups are the easy way. That means the first column should be the key for the table. The vlookup is then

=vlookup (key, Duration, 2, FALSE)

Here is some centralised DB access code

Option Explicit

Private Enum ConnectionType
    MSAccess = 0
    Sybase = 1
End Enum

Private liveConnections As Collection


Private Sub AddLiveConnection 
    (
    ByVal key As String, 
    ByRef theConnection As adodb.connection
    )
    Call CheckLiveConnections
    If Trim(key) <> "" _
            And Not (theConnection Is Nothing) _
            And LiveConnectionExists(key) = False _
            And theConnection.State = adodb.adStateOpen _
            Then
        liveConnections.Add theConnection, key
    End If
End Sub

Private Function GetLiveConnection(ByVal key As String) As adodb.connection
    CheckLiveConnections
    If CollectionItemExists(liveConnections, key) Then
        Set GetLiveConnection = liveConnections(key)
    Else
        Set GetLiveConnection = Nothing
    End If
End Function

Private Function LiveConnectionExists(ByVal key As String) As Boolean
    Dim db As adodb.connection
    
    Call CheckLiveConnections
    If CollectionItemExists(liveConnections, key) Then
        Set db = liveConnections(key)
        If db.State = adStateOpen Then
            LiveConnectionExists = True
        Else
            'The connection must have existed, but was not open, so delete it.
            Set db = Nothing
            liveConnections.Remove (key)
        End If
    End If
End Function

Private Sub CheckLiveConnections()
    'Need to check that the liveConnections array exists, as it may have died previously.
    If liveConnections Is Nothing Then
        Set liveConnections = New Collection
    End If
End Sub

Private Function GetDBConnection
    (
    ByVal connType As ConnectionType, 
    ByVal info As String
    ) As adodb.connection
    Dim odbcStr As String
    
    On Error GoTo ErrorHandler
    
    'Open a connection to the database
    Set GetDBConnection = New adodb.connection
    
    Select Case connType
        Case ConnectionType.MSAccess
            'For access databases the info is the file path of the database
            odbcStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=""" & info & """"
        Case ConnectionType.Sybase
            'For Sybase databases the info is the odbc string
            odbcStr = info & "Driver={SYBASE ASE ODBC Driver};"
    End Select
    
    GetDBConnection.ConnectionString = odbcStr
    GetDBConnection.Open
    
    Exit Function
    
ErrorHandler:
    MsgBox Err.Description
    
End Function

Public Function OpenConnection_Access(ByVal pathMDB As String) As adodb.connection
    On Error GoTo ErrorHandler
    
    Set OpenConnection_Access = GetDBConnection(MSAccess, pathMDB)
    
    Exit Function
    
ErrorHandler:
    MsgBox Err.Description
    
End Function

Public Function OpenConnection_ODBC
    (
    ByVal server As String, 
    ByVal db As String, 
    ByVal user As String, 
    ByVal password As String
    ) As adodb.connection
    On Error GoTo ErrorHandler
    
    Dim odbcString As String
    Dim key As String

    'Build the key for the collection
    key = server & "_" & db & "_" & user
    
    'Return the connection if it exists already
    If LiveConnectionExists(key) Then
        Set OpenConnection_ODBC = GetLiveConnection(key)
    Else
        odbcString = odbcString & "Srvr=" & server & ";"
        odbcString = odbcString & "Database=" & db & ";"
        odbcString = odbcString & "Pwd=" & password & ";"
        odbcString = odbcString & "uid=" & user & ";"
        Set OpenConnection_ODBC = GetDBConnection(Sybase, odbcString)
        Call AddLiveConnection(key, OpenConnection_ODBC)
    End If
    
    Exit Function
    
ErrorHandler:
    MsgBox Err.Description
    
End Function



Public Sub CloseDBConnection(ByRef dbConn As adodb.connection)

    On Error GoTo ErrorHandler
    
    'If there is a connection shut it down.
    If Not (dbConn Is Nothing) Then
        If dbConn.State = adodb.adStateOpen Then
            dbConn.Close
        End If
        Set dbConn = Nothing
    End If
    
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description
    
End Sub

Private Function SQLRecordset
    (
    ByRef dbConn As adodb.connection, 
    ByVal sql As String
    ) As adodb.Recordset

    On Error GoTo ErrorHandler
    
    Dim rs As adodb.Recordset
    
    If Not (dbConn Is Nothing) Then
        'Open a recordset
        Set rs = New adodb.Recordset
        Call rs.Open(sql, dbConn, adOpenForwardOnly)
        Set SQLRecordset = rs
    Else
        MsgBox "Cannot open recordset when there is no active database connection"
    End If
    
    Exit Function
    
ErrorHandler:
    MsgBox Err.Description
    
End Function

Public Function SQLToArray
    (
    ByRef dbConn As adodb.connection, 
    ByVal sql As String
    ) As Variant

    On Error GoTo ErrorHandler
    
    Dim rs As adodb.Recordset
    
    If Not (dbConn Is Nothing) Then
        'Open a recordset
        Set rs = New adodb.Recordset
        Call rs.Open(sql, dbConn, adOpenDynamic)
        SQLToArray = rs.GetRows()
    Else
        MsgBox "Cannot open recordset when there is no active database connection"
    End If
    
    Exit Function
    
ErrorHandler:
    MsgBox Err.Description
    
End Function

Public Sub SQLToRangeName
    (
    ByRef dbConn As adodb.connection, 
    ByVal sql As String, 
    ByRef WSTarget As Worksheet, 
    ByVal rangeNameTarget As String, 
    ByVal headers As Boolean, 
    Optional ByVal cursorType As adodb.CursorTypeEnum = adodb.CursorTypeEnum.adOpenDynamic
    )
                                
    On Error GoTo ErrorHandler
    
    Dim rs As adodb.Recordset
    Dim rng As Range
    Dim rowCount As Long
    Dim fieldCount As Integer
    
    Set rng = WSTarget.Range(rangeNameTarget)
    
    If Not (dbConn Is Nothing) Then
        'Open a recordset
        Set rs = New adodb.Recordset
        Call rs.Open(sql, dbConn, cursorType)
        
        'Copy the headers if required
        If headers Then
            For fieldCount = 0 To rs.Fields.Count - 1
                rng.Cells(1, fieldCount + 1).Value = rs.Fields(fieldCount).Name
            Next fieldCount
        End If
        
        'Copy all the records
        rowCount = rng.Cells(IIf(headers, 2, 1), 1).CopyFromRecordset(rs)
        
        'Check the sizes for the range
        rowCount = rowCount + IIf(headers, 1, 0)
        If rowCount = 0 Then rowCount = 1
        If fieldCount = 0 Then fieldCount = 1
        
        'Resize the range
        Dim TheSheet As String
        Dim TopLeft As String
        Dim BottomRight As String
        Dim RefersToString As String
            
        TheSheet = rng.Worksheet.Name
        TopLeft = rng.Cells(1, 1).address
        BottomRight = rng.Cells(rowCount, fieldCount).address
        RefersToString = "='" & TheSheet & "'!" & TopLeft & ":" & BottomRight
        Application.Names(rangeNameTarget).refersTo = RefersToString
    Else
        MsgBox "Cannot open recordset when there is no active database connection"
    End If
    
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description
    
End Sub


Public Function SQLExecute
    (
    ByRef dbConn As adodb.connection, 
    ByVal sql As String
    ) As Long

    On Error GoTo ErrorHandler
    Dim recordsAffected As Long
    
    If Not (dbConn Is Nothing) Then
        'Run the SQL
        Call dbConn.Execute(sql, recordsAffected)
    Else
        MsgBox "Cannot open recordset when there is no active database connection"
    End If
    SQLExecute = recordsAffected
    
    Exit Function
    
ErrorHandler:
    MsgBox Err.Description
    
End Function

Two major problems

1. Users are very bad at reporting errors.
2. No one knows what systems attach to particular data sources.

There is a solution that fixes both.

When accessing data, you should go through a common code routine. This can then determine the following

1. spreadsheet name
2. database name
3. database server
4. database user
5. local user
6. local machine
7. timestamp
8. success or failure
9. name of the query

Now, this can all be logged to a very simple central database.

Any failures can be reported on easily. A simple asp website is enough to report.

Now if a database moves, you can tell which spreadsheets need changing.
You know about any errors in extracting data
You know who accesses what data.