VBA for backend in server (1 Viewer)

[hfsitumo2001]

Option Compare Database
Public Function SimpleLogin_A_R1() As Boolean
Dim Source As String
Dim Target As String
Dim objFSO As Object
Dim Path As String

Source = CurrentDb.Name
'Path = CurrentProject.Path
Path = "C:\TestDB"
Target = Path & "\BackupDB_" & Format(Now(), "mm-dd-yyyy") & ".accdb"

Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.folderExists(Path) Then
    a = objFSO.copyfile(Source, Target, True)
Else
    objFSO.Createfolder (Path)
    a = objFSO.copyfile(Source, Target, True)
End If
Set objFSO = Nothing
Set a = Nothing

End Function

 

[Isaac]

Function GetUserFullName3()
On Error Resume Next
If Application.Version >= 16 Then
    'they're on o365, application.username will do and exit sub
    GetUserFullName3 = Application.UserName
    Exit Function
End If
Dim objAD, objUser, strDisplayName
    Set objAD = CreateObject("ADSystemInfo")
    Set objUser = GetObject("LDAP://" & objAD.UserName)
    If Err.Number <> 0 Then 'new error from surface/modern 10/2/2020
        Err.Clear
        Set objUser = GetObject("LDAP://" & Environ("username")) 'use alt method
        If Err.Number <> 0 Then 'still erring, abandon and return network username
            GetUserFullName3 = UCase(Environ("username"))
            Exit Function
        End If
    End If
    strDisplayName = objUser.DisplayName
    GetUserFullName3 = strDisplayName
End Function

 

[pbaldy]

I'll close this thread as it appears to have been clarified here:

VBA for backend in server _can we change the source name? can anyone help?

Option Compare Database Public Function SimpleLogin_A_R1() As Boolean Dim Source As String Dim Target As String Dim objFSO As Object Dim Path As String Source = CurrentDb.Name 'Path = CurrentProject.Path Path = "C:\TestDB" Target = Path & "\BackupDB_" & Format(Now(), "mm-dd-yyyy") & ".accdb"...

www.access-programmers.co.uk